[求助]：关于如何交互绘制ployline的问题

gjliang

请问各位，如何通过getpoint命令来绘制polyline，下面是我绘制line的程序，想同样实现绘制ployline，但无法实现，请高手指点。
Sub sdl()
Dim entry As AcadLineType
    Dim found As Boolean
    found = False
    For Each entry In ThisDrawing.Linetypes
        If StrComp(entry.Name, "acad_iso05w100", 1) = 0 Then
            found = True
            Exit For
        End If
    Next
    If Not (found) Then ThisDrawing.Linetypes.Load "acad_iso05w100", "acadiso.lin"
Dim pt1 As Variant
Dim pt2 As Variant
Dim line3 As AcadLine
pt1 = ThisDrawing.Utility.GetPoint(, "起点")
10:
On Error GoTo 20
pt2 = ThisDrawing.Utility.GetPoint(pt1, "下一点")
Set line3 = ThisDrawing.ModelSpace.AddLine(pt1, pt2)
Dim lcx As AcadLayer
Set lcx = ThisDrawing.Layers.add("虚线层")
lcx.Color = acCyan
lcx.linetype = "acad_iso05w100"
line3.Layer = "虚线层"
'line3.linetype = "acad_iso04w100"
pt1 = pt2
GoTo 10
20: Exit Sub
End Sub

lsjjm

REFER TO THIS CODE:

'Begin Code Block
Option Explicit

Public Const VK_ESCAPE = &H1B
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Public Sub DrawPline()
  Dim strPrompt As String
  Dim varPnt As Variant
  Static objPLine As AcadPolyline
  Static dblStrPnt(0 To 2) As Double
  Static varVertList(0 To 5) As Double
  Dim intNoPnts As Integer
  Dim KeyWords As String
  KeyWords = "Arc Close Length" 'not used, yet!
  strPrompt = "Specify Start Point: "
  On Error GoTo ErrControl
  ThisDrawing.Utility.InitializeUserInput 36, KeyWords
  varPnt = ThisDrawing.Utility.GetPoint(Prompt:=strPrompt)
  Do
    If intNoPnts = 0 Then
      varVertList(0) = varPnt(0)
      varVertList(1) = varPnt(1)
      varVertList(2) = varPnt(2)
      intNoPnts = intNoPnts + 1
    ElseIf intNoPnts = 1 Then
      varVertList(3) = varPnt(0)
      varVertList(4) = varPnt(1)
      varVertList(5) = varPnt(2)
      Set objPLine = ThisDrawing.ModelSpace.AddPolyline(varVertList)
      ThisDrawing.Application.Update
      intNoPnts = intNoPnts + 1
    Else
      dblStrPnt(0) = varPnt(0)
      dblStrPnt(1) = varPnt(1)
      dblStrPnt(2) = varPnt(2)
      intNoPnts = intNoPnts + 1
      objPLine.AppendVertex dblStrPnt
      ThisDrawing.Application.Update
    End If
    strPrompt = "Specify next point: "
    varPnt = ThisDrawing.Utility.GetPoint(varPnt, strPrompt)
  Loop
Exit_Here:
  Exit Sub
ErrControl:
  If CheckKey(VK_ESCAPE) Then
    Resume Exit_Here
  ElseIf Err.Description = "User input is a keyword" Then
    'Nothing yet!
    Resume Exit_Here
  Else
    MsgBox Err.Description, vbOKOnly, "Llama Control Center"
  End If
End Sub

Function CheckKey(lngKey As Long) As Boolean
  If GetAsyncKeyState(lngKey) Then
    CheckKey = True
  Else
    CheckKey = False
  End If
End Function
'End Code Block

gjliang

　　其实我的这个问题是可以这样想的，我的那段程序可以用在那些以线形和线宽来命名建立图层的绘图工作中的，这样在使用直线命令过程中就可以不用考虑切换图层的问题了，拿我的那段程序来说，把sdl()过程定义一个外部快捷命令sdl，这样当你想画细双点线的线段时就可以完全不用考虑这个线画到那里了，因为它会被指定到虚线层上的。而这个层也是你在使用这个命令时自动建立的。