- 积分
- 184
- 明经币
- 个
- 注册时间
- 2014-3-19
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
小弟刚编完一个软件,是VBA编程的。做完后想把整个图形做一次多段线合并操作。查阅了不少资料,最后别人给我一段代码,原本
他那个都是三维多段线画的,我的是二维,就稍微改了下,可是运行程序也不能合并多段线,也不报错,希望有人能帮忙分析下我的
代码,看看哪里错了,谢谢哦!!
Dim PlineObj As AcadLWPolyline
Dim ss_line As AcadSelectionSet
Dim ent As AcadEntity
Dim line_code(0) As Integer
Dim line_value(0) As Variant
Dim coord As Variant
' Dim i, j As Long
' On Error GoTo errexit
Set ss_line = AcadApp.ActiveDocument.SelectionSets.Add("sPolyLines")
line_code(0) = 0
line_value(0) = "POLYLINE"
ss_line.Select acSelectionSetAll ', , , line_code, line_value
For Each ent In ss_line
' ent.color = acGreen
If ent.ObjectName = "AcadLWPolyline" Then
Dim PL2D() As Double
Dim count As Integer
Dim ent2D As AcadLWPolyline
Set ent2D = ent
ent.color = acGreen
count = (UBound(ent2D.Coordinates) + 1) / 2
ReDim Preserve PL2D(cuunt * 2 - 1) As Double
For j = 0 To UBound(ent2D.Coordinates) / 2
PL2D(j * 2) = ent2D.Coordinates(j * 2)
PL2D(j * 2 + 1) = ent2D.Coordinates(j * 2 + 1)
Next
Set PlineObj = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(PL2D)
PlineObj.Closed = ent2D.Closed
PlineObj.color = ent2D.color
PlineObj.Linetype = ent2D.Linetype
PlineObj.Layer = ent2D.Layer
PlineObj.LinetypeScale = ent2D.LinetypeScale
PlineObj.Lineweight = ent2D.Lineweight
ent2D.Delete
End If
ent.Update
Next
'errexit:
' ss_line.Clear
ss_line.Delete
|
|