|
|
发表于 2009-4-10 07:59:00
|
显示全部楼层
我已经解决了这个问题，如下即可：
本人在贵网站学到了很多知识，为了感谢贵网站，本人把修改完整的代码放在下面，调试通过
Sub Example_Layer()
'图在附件中，关于面积自动注记的一个小程序,在cad中绘制一个闭合的pl线，使用此程序自动注记面积
Dim x, y As Double
Dim coor() As Double
Dim pt(2) As Double '注记坐标
'Dim pl As AcadObject
Dim pl As AcadEntity
Dim pl1 As AcadPolyline
Dim layerObj As AcadLayer
Dim sset As AcadSelectionSet
Dim zjtxt As AcadText
'On Error Resume Next
If Not IsNull(ThisDrawing.SelectionSets.Item("this")) Then
Set sset = ThisDrawing.SelectionSets.Item("this")
sset.Delete
End If
Set sset = ThisDrawing.SelectionSets.Add("this")
sset.SelectOnScreen
'Set layerObj = ThisDrawing.Layers.Add("ABC")
Dim i As Integer
For Each pl In sset
'If entity.Layer = Trim(UserForm1.ComboBox1.Text) Then
i = 0
If pl.ObjectName = "AcDbPolyline" And pl.Closed = True Then
i = i + 1
'这个地方出问题了，怎样解决？
’ Set pl1 = pl
coor = pl.Coordinates
End If
For i = 0 To (UBound(coor) - 1) Step 2
'ss = ss + Str(coor(i)) + vbCrLf
'ss = ss + Str(UBound(coor))
x = x + coor(i)
y = y + coor(i + 1)
Next i
pt(0) = x / ((UBound(coor) + 1) / 2)
pt(1) = y / ((UBound(coor) + 1) / 2)
pt(2) = 0
Set zjtxt = ThisDrawing.ModelSpace.AddText(Str(pl.Area), pt, 3)
'End If
Next
exit sub
'MsgBox Str(x / 4) + "," + Str(y / 4)
End Sub |
|
置顶卡
