Xline to Line and LTSCALE override

By Adam Nagy

Just a couple of utility functions here.

One converts all the Construction Lines (AcadXline/Xline/AcDbXline – in case someone is searching for a different name :)) to Line entities (AcadLine/Line/AcDbLine). You may need this if you have xline's in a block and you would like to snap to them outside the block. It does not seem possible, whereas line's are snappable even outside the block:

' Application Session Command with localized name
 _
Public Shared Sub AcmUtilConvertXlines() ' This method can have any name
  Dim doc As Document = acApp.DocumentManager.MdiActiveDocument
 
  Dim db As Database = doc.Database
 
  Using tr As Transaction = db.TransactionManager.StartTransaction()
 
    ' Just something crude to start with
    Dim length As Double
    length = db.Extmin.DistanceTo(db.Extmax) * 2
 
    Dim bt As BlockTable
    bt = tr.GetObject(db.BlockTableId, OpenMode.ForRead)
 
    For Each blockId In bt
      Dim block As BlockTableRecord
      block = tr.GetObject(blockId, OpenMode.ForRead)
 
      Dim modified As Boolean = False
 
      For Each entId In block
        If entId.ObjectClass = Xline.GetClass(GetType(Xline)) Then
          If Not modified Then
            block.UpgradeOpen()
            modified = True
          End If
 
          Dim xl As Xline = tr.GetObject(entId, OpenMode.ForWrite)
 
          Using l As New Line
            l.StartPoint = xl.BasePoint.Add(xl.UnitDir.MultiplyBy(-length))
            l.EndPoint = xl.BasePoint.Add(xl.UnitDir.MultiplyBy(length))
            l.Layer = xl.Layer
            l.Color = xl.Color
            block.AppendEntity(l)
            tr.AddNewlyCreatedDBObject(l, True)
          End Using
 
          xl.Erase()
        End If
      Next
 
      ' If the block got modified then let's update its references
      If modified Then
        For Each brId As ObjectId In block.GetBlockReferenceIds(True, True)
          Dim br As BlockReference
          br = tr.GetObject(brId, OpenMode.ForWrite)
          br.RecordGraphicsModified(True)
        Next
      End If
    Next
 
    tr.Commit()
  End Using
End Sub

The  other overrides the LTSCALE value before using the HATCH command and then sets it back afterwards. You may need this if you have dashed lines closing an area you want to hatch – the hatch preview looks OK but the created hatch might extend beyond the selected area. This can be prevented by using a smaller LTSCALE value:

Shared ltscale As Double
 
' Application Session Command with localized name
 _
Public Shared Sub AcmUtilHatch() ' This method can have any name
  Dim doc As Document = acApp.DocumentManager.MdiActiveDocument
 
  ltscale = doc.Database.Ltscale
  doc.Database.Ltscale = 0.01
  doc.Editor.Regen()
 
  doc.SendStringToExecute("_.HATCH ", False, False, False)
 
  AddHandler doc.CommandEnded, AddressOf doc_CommandEnded
  AddHandler doc.CommandCancelled, AddressOf doc_CommandEnded
  AddHandler doc.CommandFailed, AddressOf doc_CommandEnded
End Sub
 
Public Shared Sub doc_CommandEnded(sender As Object, e As Autodesk.AutoCAD.ApplicationServices.CommandEventArgs)
  If e.GlobalCommandName = "HATCH" Then
    Dim doc As Document = sender
    RemoveHandler doc.CommandEnded, AddressOf doc_CommandEnded
    RemoveHandler doc.CommandCancelled, AddressOf doc_CommandEnded
    RemoveHandler doc.CommandFailed, AddressOf doc_CommandEnded
 
    doc.Database.Ltscale = ltscale
    doc.Editor.Regen()
  End If
End Sub

There might be nicer solutions to the problem. This is just a quick solution: Download AcmUtility
The attachment also contains the compiled project for AutoCAD 2013/2014 and the bundle that can be simply placed in the appropriate folder on the system so that it will be loaded automatically into AutoCAD: http://docs.autodesk.com/ACD/2013/ENU/index.html?url=files/GUID-5E50A846-C80B-4FFD-8DD3-C20B22098008.htm,topicNumber=d30e503195