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

大家好，欢迎来到IT知识分享网。

在 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