社区 › VBA/VB/ActiveX/API 编程技术 › 提示输入点创建一条轻多段线

yjr111 发表于 2013-2-6 13:59:59

提示输入点创建一条轻多段线

本帖最后由 yjr111 于 2013-2-6 14:15 编辑

rem 模拟cad的pline命令
Option Explicit
Public ms As AcadModelSpace, utiobj As Object
'提示输入点创建一条轻多段线
Private Sub AddLWPline()
    Dim p1 As Variant, ptCurrent As Variant, ptPrevious As Variant
    Dim points(3) As Double, objPline As AcadLWPolyline
    Set utiobj = ThisDrawing.Utility
    Set ms = ThisDrawing.ModelSpace

    On Error Resume Next
    p1 = utiobj.GetPoint(, "输入第一点:")
    If Err.Number = -2145320928 Then
      Err.Clear
      Exit Sub
    End If
    ptPrevious = p1
    While true
      On Error Resume Next
      ptCurrent = utiobj.GetPoint(ptPrevious, "输入下一点:")
      If Err.Number = -2145320928 Then
            Err.Clear
            Exit Sub
      End If
      points(0) = ptPrevious(0)
      points(1) = ptPrevious(1)
      points(2) = ptCurrent(0)
      points(3) = ptCurrent(1)
      Set objPline = ms.AddLightWeightPolyline(points)
      ptPrevious = ptCurrent
    Wend
End Sub

mycad 发表于 2013-2-27 18:07:55

最好把每一段轻量多一线连成一条整线

oistre 发表于 2018-8-21 19:52:53

查看完整版本: 提示输入点创建一条轻多段线