将多边形各边边长注记在各边中点上源代码（VBA）
本帖最后由 作者 于 2003-12-17 17:43:48 编辑不足之处，请完善Const pi = 3.1415926
Sub add_dis_to_midp()
Dim entry As Object
Dim pickedp As Variant
Dim pickedp1 As Variant
Dim coors As Variant
Dim vexn As Integer
Dim i As Integer
Dim midtext As AcadText
Dim textstr As String
Dim ang As Double
Dim Ispoly As Boolean
Ispoly = False
On Error Resume Next
Dim textheight1 As Double
textheight1 = 1#'定义字高
Dim offsetvalue As Double
offsetvalue = 0.5 '定义文字偏移直线的距离
Dim inserttext(0 To 2) As Double
ThisDrawing.Utility.GetEntity entry, pickedp, "选择一个多边形:"
'获得顶点数
If TypeName(entry) = "IAcadLWPolyline" Then
vexn = (UBound(entry.Coordinates) + 1) / 2
Ispoly = True
End If
If TypeName(entry) = "IAcadPolyline" Then
vexn = (UBound(entry.Coordinates) + 1) / 3
Ispoly = True
End If
If Ispoly Then
For i = 0 To vexn - 1 Step 1
pickedp = entry.Coordinate(i)
If i = vexn - 1 And entry.Closed = True Then
pickedp1 = entry.Coordinate(0)
Else
pickedp1 = entry.Coordinate(i + 1)
End If
'线段中点
inserttext(0) = (pickedp(0) + pickedp1(0)) / 2
inserttext(1) = (pickedp(1) + pickedp1(1)) / 2
inserttext(2) = 0
'线段距离
textstr = CStr(dist(pickedp, pickedp1))
'文字角度
'ang = ThisDrawing.Utility.AngleFromXAxis(pickedp, pickedp1)
ang = getang(pickedp, pickedp1) '+ pi 加pi表示文字在前进反向的右边，不加是左边
'偏移处理
pickedp = ThisDrawing.Utility.PolarPoint(inserttext, ang + pi / 2, offsetvalue)
inserttext(0) = pickedp(0)
inserttext(1) = pickedp(1)
inserttext(2) = 0
'写文字
If textstr <> "0" Then '0距离不处理
Set midtext = ThisDrawing.ModelSpace.AddText(textstr, inserttext, textheight1)
midtext.Alignment = acAlignmentCenter
midtext.TextAlignmentPoint = inserttext
midtext.Rotation = ang
End If
Next
End If
End Sub
Function dist(p1 As Variant, p2 As Variant) As Double '距离
On Error Resume Next
dist = Sqr(((p1(0) - p2(0)) ^ 2 + (p1(1) - p2(1)) ^ 2))
If Err Then
Err.Clear
dist = 0
End If
End Function
Function getang(p1 As Variant, p2 As Variant) '角度
On Error Resume Next
Dim pl As AcadLine
Dim startp(0 To 2) As Double
Dim endp(0 To 2) As Double
startp(0) = p1(0)
startp(1) = p1(1)
startp(2) = 0
endp(0) = p2(0)
endp(1) = p2(1)
endp(2) = 0
Set pl = ThisDrawing.ModelSpace.AddLine(startp, endp)
getang = pl.Angle
pl.Delete
End Function
计算角度可以用AngleFromXAxis 方法
标注的文字最好按照当前标注样式的大小和小数点位数来标注，并注意文字的旋转角度。 ang = ThisDrawing.Utility.AngleFromXAxis(pickedp, pickedp1) + pi
跟ang = getang(pickedp, pickedp1) + pi
运行的结果不同，何解？ 谢谢各位老大帮了我大忙！ 可能是因为AngleFromXAxis方法需要三维点，而二维多段线的顶点是二维点。
页:
[1]