在中点画圆+文字
'Creates a single line of text.Function PipeNoText(cadApp As AcadApplication, pp, Str)
Dim objText As AcadText, objCircle As AcadCircle
Dim alignmentPoint(0 To 2) As Double
For ii = 0 To 2
alignmentPoint(ii) = pp(ii) '+ 0.001
Next ii
With cadApp.ActiveDocument.ModelSpace
Set objText = .AddText(Str, pp, 4)
With objText
' .Layer = "件号"
.Alignment = acAlignmentMiddleCenter
.TextAlignmentPoint = alignmentPoint 'alignmentPoint
End With
Set objCircle = .AddCircle(pp, 4)
With objCircle
'.Layer = "件号"
End With
End With
End Function
Sub ll()
Dim cadApp As AcadApplication, objLine As AcadLine
Dim Pt
With ThisDrawing
Set cadApp = ThisDrawing.Application
Set objLine = .HandleToObject("89B")
Pt = midPtOneLine(cadApp, objLine)
temp = PipeNoText(cadApp, Pt, "ee")
End With
End Sub
Function midPtOneLine(cadApp As AcadApplication, objLine As AcadLine) As Variant
Dim Pt(2) As Double
With objLine
Pt(0) = .StartPoint(0) + (.EndPoint(0) - .StartPoint(0)) / 2
Pt(1) = .StartPoint(1) + (.EndPoint(1) - .StartPoint(1)) / 2
End With
midPtOneLine = Pt
Exit Function
For ii = 0 To 2
'midPtOneLine(ii) = Pt(ii)
Next ii
End Function
这个函数很好，怎么用这个函数呢？版主写一个调用这个函数的小程序吧 好吗 谢谢 yp9819 发表于 2020-5-16 19:22
这个函数很好，怎么用这个函数呢？版主写一个调用这个函数的小程序吧 好吗 谢谢
temp问题在这里
页:
[1]