我确实需要这个，但它返回错误消息
你能修复它并上传吗
非常感谢你帮助我。 我处理闭合多边形，因此您可能需要调整代码，使其处理多个顶点
该代码偏移多段线。返回区域（如果较大或较小）也会告诉您垂直方向
Public Function DirPolSante(polyEnt As AcadEntity) As String
Dim OffsetObj As Variant
Dim AreaObj As Double
Dim AreaOffset As Double
AreaObj = polyEnt.Area
OffsetObj = polyEnt.Offset(0.01)
AreaOffset = OffsetObj(0).Area
OffsetObj(0).Delete
If AreaOffsetnumBulge Then
newbulge(numBulge - idx) = polyEnt.GetBulge(idx) * -1
Else
newbulge(0) = polyEnt.GetBulge(idx) * -1
End If
Next idx
'reverse the original pline
polyEnt.Coordinates = newcoord
For idx = 0 To numBulge
If idx = 0 Then
polyEnt.SetBulge (numBulge), newbulge(idx)
Else
polyEnt.SetBulge (idx - 1), newbulge(idx)
End If
Next idx
polyEnt.Update
End Sub 这将LW多段线转换为；二维多段线。当您必须在代码末尾使用2D多边形时，非常适合较旧的CNC程序。ACAD在LW多段线上使用Pedit做得更好（sendcommand）：
Public Function polyentconvert(polyEnt As Object) As AcadPolyline
Dim entity As AcadDocument
Set entity = AutoCAD_Application.ActiveDocument
Dim I As Integer, j As Integer, K As Integer
If polyEnt.EntityName = "AcDbPolyline" Then
Dim Coords As Variant
Coords = polyEnt.Coordinates
I = Fix((UBound(Coords) + 1) * 1.5) - 1
ReDim Coords2(I) As Double
j = 0
Dim X As Double, y As Double, z As Double
For I = LBound(Coords) To UBound(Coords) Step 2
X = Coords(I): y = Coords(I + 1): z = 0#
Coords2(j) = X:
Coords2(j + 1) = y:
Coords2(j + 2) = z:
j = j + 3
Next I
Dim Coords2V As Variant
Coords2V = Coords2
Dim EN2 As AcadPolyline
Set EN2 = entity.ModelSpace.AddPolyline(Coords2V)
EN2.Closed = polyEnt.Closed
EN2.Color = polyEnt.Color
EN2.Linetype = polyEnt.Linetype
EN2.Thickness = polyEnt.Thickness
EN2.Layer = polyEnt.Layer
Dim b As Double, w As Double, W2 As Double
For I = 0 To UBound(Coords) Step 2
j = I / 2
b = polyEnt.GetBulge(j)
polyEnt.GetWidth j, w, W2
EN2.SetBulge j, b
EN2.SetWidth j, w, W2
Next I
Dim polyentx As AcadPolyline
Set polyentx = EN2
polyEnt.Delete
End If
End Function 这段代码的大部分都可以贡献给Malcom Fernadaz。他的代码使用开放多段线。我修改了它来处理封闭的 非常感谢你，Davew！
页:
1
[2]