OCE 源头代码：AutoCAD VBA 直线转轻量多段线

在 AutoCAD 中，有多种方法将直线 acadLine 转换为轻量多段线 acadLWPolyline。

本文提供 AutoCAD VBA 代码实现方法。

只需要两个 Sub 过程：1）选择集创建；2）对象类型转换过程。

Option Explicit

---------------------------------------------------------------------------------------

Public Sub LineToPLines()   ' 对象转换主过程

Dim Objt As Object
Dim SeleObjts As AcadSelectionSet

Call CreateSelectionSet(SeleObjts, "SeleObjts")

SeleObjts.SelectOnScreen

Dim nLine As Long
Dim Lines() As AcadLine

Dim i As Long
Dim PLine As AcadLWPolyline

' 下面开始转换 begin to transformer ..... 

Dim Layer As AcadLayer:  Set Layer = ThisDraw.Layers.Add("OCE PLines")

For Each Objt In SeleObjts

If TypeOf Objt Is AcadLine Then
  nLine = nLine + 1: ReDim Preserve Lines(1 To nLine): Set Lines(nLine) = Objt
End If
   
Next Objt

Set SeleObjts = Nothing

Dim pt(3) As Double

For i = 1 To UBound(Lines)

  pt(0) = Lines(i).StartPoint(0):  pt(2) = Lines(i).EndPoint(0)
  pt(1) = Lines(i).StartPoint(1):  pt(3) = Lines(i).EndPoint(1)
  
  Set PLine = ThisDraw.ModelSpace.AddLightWeightPolyline(pt)
  
  PLine.ConstantWidth = 300
  
  PLine.Layer = "OCE PLines"

Next i

MsgBox "Lines are kept; New PLines are in OCE PLines Layer --- by Oceanable 2024.01.01" + Chr(10) + "原直线仍然保留；新创建的 PL 线都放在 OCE PLines 图层中！"

End Sub

---------------------------------------------------------------------------------------

Public Sub CreateSelectionSet(SeleObjts As AcadSelectionSet, Name As String)

On Error Resume Next

If Not IsNull(ThisDrawing.SelectionSets.Item(Name)) Then
Set SeleObjts = ThisDrawing.SelectionSets.Item(Name)
SeleObjts.Delete
End If

Set SeleObjts = ThisDrawing.SelectionSets.Add(Name)

End Sub