Dim Inp1 As Variant, Inp2 As Variant
Dim LinX As AcadLine
'获取起点
Inp1 = GetPoint("请指定PIN1的起点:")
If IsEmpty(Inp1) Then Exit For
Inp2 = GetPoint("请指定PIN2的终点:", Val(Inp1(0)), Val(Inp1(1)))
If IsEmpty(Inp2) Then Exit For
Set LinX = acadApp.ActiveDocument.ModelSpace.AddLine(Inp1, Inp2)
LinX.Update
'获取 CAD的坐标点
Public Function GetPoint(Prompt As String, Optional BasePntX As Double = 0, Optional BasePntY As Double = 0) As Variant
On Error GoTo Err_GetPoint
Dim P1(0 To 2) As Double
If BasePntX = 0 And BasePntY = 0 Then '没有第1点
GetPoint = acadApp.ActiveDocument.Utility.GetPoint(, Prompt)
Else
P1(0) = BasePntX: P1(1) = BasePntY
GetPoint = acadApp.ActiveDocument.Utility.GetPoint(P1, Prompt)
End If
Exit Function
Err_GetPoint:
End Function
CAD 画直线
最新推荐文章于 2023-06-19 08:49:49 发布