[求助]关于如何交互绘制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

topirol

看看行不行

2. Sub kkk()
   
3. Dim entry As AcadLineType
   
4.     Dim found As Boolean
   
5.     found = False
   
6.     For Each entry In ThisDrawing.Linetypes
   
7.         If StrComp(entry.Name, "acad_iso05w100", 1) = 0 Then
   
8.             found = True
   
9.             Exit For
   
10.         End If
    
11.     Next
    
12.     If Not (found) Then ThisDrawing.Linetypes.Load "acad_iso05w100", "acadiso.lin"
    
13.    
    
14.    
    
15.    
    
16. Dim fzpl As AcadPolyline
    
17. Dim zbd As Variant
    
18. Dim zbd1 As Variant
    
19. Dim i As Integer
    
20. Dim blist() As Double
    
21. Dim lcx As AcadLayer
    
22. Set lcx = ThisDrawing.Layers.Add("虚线层")
    
23. lcx.Color = acCyan
    
24. 
    
25. 
    
26. On Error Resume Next
    
27. Do
    
28. If IsEmpty(zbd1) Then
    
29.   zbd = ThisDrawing.Utility.GetPoint(, "第一点：")
    
30.   Else
    
31.   zbd = ThisDrawing.Utility.GetPoint(zbd1, "下一点：")
    
32.   End If
    
33.   
    
34.   
    
35.   If Err Then
    
36.     Err.Clear
    
37.     Exit Do
    
38.   End If
    
39.   ReDim Preserve blist(3 * i + 2)
    
40.   blist(3 * i) = zbd(0): blist(3 * i + 1) = zbd(1): blist(3 * i + 2) = zbd(2)
    
41.   i = i + 1
    
42.   
    
43.   zbd1 = zbd
    
44. Loop
    
45. 
    
46. Set fzpl = ThisDrawing.ModelSpace.AddPolyline(blist)
    
47. 
    
48. fzpl.Linetype = "acad_iso05w100"
    
49. fzpl.Layer = "虚线层"
    
50. End Sub
    

Sub kkk()<br /> Dim entry As AcadLineType<br />     Dim found As Boolean<br />     found = False<br />     For Each entry In ThisDrawing.Linetypes<br />         If StrComp(entry.Name, "acad_iso05w100", 1) = 0 Then<br />             found = True<br />             Exit For<br />         End If<br />     Next<br />     If Not (found) Then ThisDrawing.Linetypes.Load "acad_iso05w100", "acadiso.lin"<br />     <br />     <br />     <br /> Dim fzpl As AcadPolyline<br /> Dim zbd As Variant<br /> Dim zbd1 As Variant<br /> Dim i As Integer<br /> Dim blist() As Double<br /> Dim lcx As AcadLayer<br /> Set lcx = ThisDrawing.Layers.Add("虚线层")<br /> lcx.Color = acCyan<br /> <br /> <br /> On Error Resume Next<br /> Do<br /> If IsEmpty(zbd1) Then<br />   zbd = ThisDrawing.Utility.GetPoint(, "第一点：")<br />   Else<br />   zbd = ThisDrawing.Utility.GetPoint(zbd1, "下一点：")<br />   End If<br />   <br />   <br />   If Err Then<br />     Err.Clear<br />     Exit Do<br />   End If<br />   ReDim Preserve blist(3 * i + 2)<br />   blist(3 * i) = zbd(0): blist(3 * i + 1) = zbd(1): blist(3 * i + 2) = zbd(2)<br />   i = i + 1<br />   <br />   zbd1 = zbd<br /> Loop<br /> <br /> Set fzpl = ThisDrawing.ModelSpace.AddPolyline(blist)<br /> <br /> fzpl.Linetype = "acad_iso05w100"<br /> fzpl.Layer = "虚线层"<br /> End Sub<br />

efan2000

知道了起点和第二点之后就可以八绘制一条多段线了，以后的点通过AddVertex来添加。

2. 
   
3. Sub Example_AddVertex()
   
4.     ' This example creates a light weight polyline in model space.
   
5.     ' It then adds a vertex to the polyline.
   
6. 
   
7.     Dim plineObj As AcadLWPolyline
   
8.     Dim points(0 To 9) As Double
   
9.    
   
10.    
    
11.     ' Define the 2D polyline points
    
12.     points(0) = 1: points(1) = 1
    
13.     points(2) = 1: points(3) = 2
    
14.     points(4) = 2: points(5) = 2
    
15. 
    
16.     points(6) = 3: points(7) = 2
    
17.     points(8) = 4: points(9) = 4
    
18.         
    
19.     ' Create a light weight Polyline object in model space
    
20.     Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
    
21.     ZoomAll
    
22.     MsgBox "Add a vertex to the end of the polyline.", , "AddVertex Example"
    
23.    
    
24.     ' Define the new vertex
    
25.     Dim newVertex(0 To 1) As Double
    
26.     newVertex(0) = 4: newVertex(1) = 1
    
27. 
    
28.    
    
29.     ' Add the vertex to the polyline
    
30.     plineObj.AddVertex 5, newVertex
    
31.     plineObj.Update
    
32.     MsgBox "Vertex added.", , "AddVertex Example"
    
33.    
    
34. End Sub
    

<br /> Sub Example_AddVertex()<br />     ' This example creates a light weight polyline in model space.<br />     ' It then adds a vertex to the polyline.<br /> <br />     Dim plineObj As AcadLWPolyline<br />     Dim points(0 To 9) As Double<br />     <br />     <br />     ' Define the 2D polyline points<br />     points(0) = 1: points(1) = 1<br />     points(2) = 1: points(3) = 2<br />     points(4) = 2: points(5) = 2<br /> <br />     points(6) = 3: points(7) = 2<br />     points(8) = 4: points(9) = 4<br />         <br />     ' Create a light weight Polyline object in model space<br />     Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)<br />     ZoomAll<br />     MsgBox "Add a vertex to the end of the polyline.", , "AddVertex Example"<br />     <br />     ' Define the new vertex<br />     Dim newVertex(0 To 1) As Double<br />     newVertex(0) = 4: newVertex(1) = 1<br /> <br />     <br />     ' Add the vertex to the polyline<br />     plineObj.AddVertex 5, newVertex<br />     plineObj.Update<br />     MsgBox "Vertex added.", , "AddVertex Example"<br />     <br /> End Sub<br />

topirol

完善一下：

2. Sub kkk()
   
3. Dim entry As AcadLineType
   
4.     Dim found As Boolean
   
5.     found = False
   
6.     For Each entry In ThisDrawing.Linetypes
   
7.         If StrComp(entry.Name, "acad_iso05w100", 1) = 0 Then
   
8.             found = True
   
9.             Exit For
   
10.         End If
    
11.     Next
    
12.     If Not (found) Then ThisDrawing.Linetypes.Load "acad_iso05w100", "acadiso.lin"
    
13.    
    
14.    
    
15.    
    
16. Dim fzpl As AcadPolyline
    
17. Dim zbd As Variant
    
18. Dim zbd1 As Variant
    
19. Dim i As Integer
    
20. Dim blist() As Double
    
21. Dim lcx As AcadLayer
    
22. Set lcx = ThisDrawing.Layers.Add("虚线层")
    
23. lcx.Color = acCyan
    
24. 
    
25. 
    
26. On Error Resume Next
    
27. Do
    
28. If IsEmpty(zbd1) Then
    
29.   zbd = ThisDrawing.Utility.GetPoint(, "第一点：")
    
30.   Else
    
31.   zbd = ThisDrawing.Utility.GetPoint(zbd1, "下一点：")
    
32.   End If
    
33.   
    
34.   
    
35.   If Err Then
    
36.     Err.Clear
    
37.     Exit Do
    
38.   End If
    
39.   ReDim Preserve blist(3 * i + 2)
    
40.   blist(3 * i) = zbd(0): blist(3 * i + 1) = zbd(1): blist(3 * i + 2) = zbd(2)
    
41.   i = i + 1
    
42.   
    
43. 
    
44.   
    
45.   If i = 1 Then
    
46.   GoTo ppp
    
47.   End If
    
48.   
    
49.   If i = 2 Then
    
50.   Dim start(0 To 5) As Double
    
51. 
    
52.   start(0) = zbd1(0)
    
53.   start(1) = zbd1(1)
    
54.   start(2) = zbd1(2)
    
55.   start(3) = zbd(0)
    
56.   start(4) = zbd(1)
    
57.   start(5) = zbd(2)
    
58.   
    
59.   Set fzpl = ThisDrawing.ModelSpace.AddPolyline(start)
    
60.   fzpl.Linetype = "acad_iso05w100"
    
61. fzpl.Layer = "虚线层"
    
62. fzpl.Update
    
63.   GoTo ppp
    
64.    
    
65.   End If
    
66.   
    
67.   
    
68.   fzpl.Coordinates = blist
    
69.   fzpl.Update
    
70. ppp:
    
71. zbd1 = zbd
    
72. Loop
    
73. 
    
74. fzpl.Coordinates = blist
    
75. 
    
76. End Sub
    

Sub kkk()<br /> Dim entry As AcadLineType<br />     Dim found As Boolean<br />     found = False<br />     For Each entry In ThisDrawing.Linetypes<br />         If StrComp(entry.Name, "acad_iso05w100", 1) = 0 Then<br />             found = True<br />             Exit For<br />         End If<br />     Next<br />     If Not (found) Then ThisDrawing.Linetypes.Load "acad_iso05w100", "acadiso.lin"<br />     <br />     <br />     <br /> Dim fzpl As AcadPolyline<br /> Dim zbd As Variant<br /> Dim zbd1 As Variant<br /> Dim i As Integer<br /> Dim blist() As Double<br /> Dim lcx As AcadLayer<br /> Set lcx = ThisDrawing.Layers.Add("虚线层")<br /> lcx.Color = acCyan<br /> <br /> <br /> On Error Resume Next<br /> Do<br /> If IsEmpty(zbd1) Then<br />   zbd = ThisDrawing.Utility.GetPoint(, "第一点：")<br />   Else<br />   zbd = ThisDrawing.Utility.GetPoint(zbd1, "下一点：")<br />   End If<br />   <br />   <br />   If Err Then<br />     Err.Clear<br />     Exit Do<br />   End If<br />   ReDim Preserve blist(3 * i + 2)<br />   blist(3 * i) = zbd(0): blist(3 * i + 1) = zbd(1): blist(3 * i + 2) = zbd(2)<br />   i = i + 1<br />   <br /> <br />   <br />   If i = 1 Then<br />   GoTo ppp<br />   End If<br />   <br />   If i = 2 Then<br />   Dim start(0 To 5) As Double<br /> <br />   start(0) = zbd1(0)<br />   start(1) = zbd1(1)<br />   start(2) = zbd1(2)<br />   start(3) = zbd(0)<br />   start(4) = zbd(1)<br />   start(5) = zbd(2)<br />   <br />   Set fzpl = ThisDrawing.ModelSpace.AddPolyline(start)<br />   fzpl.Linetype = "acad_iso05w100"<br /> fzpl.Layer = "虚线层"<br /> fzpl.Update<br />   GoTo ppp<br />     <br />   End If<br />   <br />   <br />   fzpl.Coordinates = blist<br />   fzpl.Update<br /> ppp:<br /> zbd1 = zbd<br /> Loop<br /> <br /> fzpl.Coordinates = blist<br /> <br /> End Sub<br />

gjliang

非常好，感谢topirol的热心帮助！！！

今晚打老虎

真的比偶作的简单多了~~~~~

偶地代码就不好意思贴了~~~

莫名

再有闭合和回退功能就更完善了！谢谢topiro！!
还请有空完善。

topirol

功能可以实现，不过我觉得代码不是很好，将就吧，希望有人再来完善一下

2. 
   
3. 
   
4. Sub kkk1()
   
5. Dim entry As AcadLineType
   
6.     Dim found As Boolean
   
7.     found = False
   
8.     For Each entry In ThisDrawing.Linetypes
   
9.         If StrComp(entry.Name, "acad_iso05w100", 1) = 0 Then
   
10.             found = True
    
11.             Exit For
    
12.         End If
    
13.     Next
    
14.     If Not (found) Then ThisDrawing.Linetypes.Load "acad_iso05w100", "acadiso.lin"
    
15.    
    
16.    
    
17.    
    
18. Dim fzpl As AcadPolyline
    
19. Dim zbd As Variant
    
20. Dim zbd1 As Variant
    
21. Dim startpoint As Variant
    
22. Dim i As Integer
    
23. Dim j As Integer
    
24. Dim blist() As Double
    
25. Dim lcx As AcadLayer
    
26. Set lcx = ThisDrawing.Layers.Add("虚线层")
    
27. lcx.Color = acCyan
    
28. 
    
29. 
    
30. On Error Resume Next
    
31.      Dim keywordList As String
    
32.     keywordList = "Close Undo"
    
33.    
    
34.    
    
35. Do
    
36. If IsEmpty(zbd1) Then
    
37.   zbd = ThisDrawing.Utility.GetPoint(, "第一点:")
    
38. 
    
39.   startpoint = zbd
    
40.   Else
    
41. restart:
    
42.   ThisDrawing.Utility.InitializeUserInput 128, keywordList
    
43.   zbd = ThisDrawing.Utility.GetPoint(zbd1, "下一点[闭合(C)/后退(U)]:")
    
44.         If Err Then
    
45.   
    
46.                     If Err.Number = -2147467259 Then
    
47.                             Dim inputString As String
    
48.                              Err.Clear
    
49.                              inputString = ThisDrawing.Utility.GetInput
    
50.                                     If inputString = "Close" Then
    
51.                                        fzpl.Closed = True
    
52.                                     End If
    
53.                                     If inputString = "Undo" Then
    
54.                                     i = i - 2
    
55.                                     If i = 0 Then
    
56.                                     
    
57.                                     fzpl.Delete
    
58.                                     zbd1 = startpoint
    
59.                                     blist(0) = zbd1(0)
    
60.                                     blist(1) = zbd1(1)
    
61.                                     blist(2) = zbd1(2)
    
62.                                     i = 1
    
63.                                     GoTo restart
    
64.                                     'End
    
65.                                     End If
    
66.                                     If i < 0 Then
    
67.                                     End
    
68.                                     End If
    
69.                                     ReDim Preserve blist(3 * i + 2)
    
70.                                     GoTo endundo
    
71.                                     End If
    
72.                                     
    
73.                                     
    
74.                                      Exit Do
    
75.                      End If
    
76.         End If
    
77.         
    
78.   End If
    
79. 
    
80.   If Err Then
    
81.          
    
82.                     Err.Clear
    
83.                     Exit Do
    
84.    
    
85.               
    
86.   End If
    
87.   ReDim Preserve blist(3 * i + 2)
    
88.   blist(3 * i) = zbd(0): blist(3 * i + 1) = zbd(1): blist(3 * i + 2) = zbd(2)
    
89. 
    
90.   If i = 0 Then
    
91.   zbd1 = zbd
    
92.   GoTo ppploop
    
93. 
    
94.   End If
    
95.   
    
96.   If i = 1 Then
    
97.   
    
98.   Dim start(0 To 5) As Double
    
99. 
    
100.   start(0) = blist(0)
     
101.   start(1) = blist(1)
     
102.   start(2) = blist(2)
     
103.   start(3) = blist(3)
     
104.   start(4) = blist(4)
     
105.   start(5) = blist(5)
     
106.   
     
107.   Set fzpl = ThisDrawing.ModelSpace.AddPolyline(start)
     
108.   fzpl.Linetype = "acad_iso05w100"
     
109. fzpl.Layer = "虚线层"
     
110. fzpl.Update
     
111. 
     
112. zbd1 = zbd
     
113.   GoTo ppploop
     
114.    
     
115.   End If
     
116.   
     
117. endundo:
     
118. 
     
119.   fzpl.Coordinates = blist
     
120.   
     
121.   fzpl.Update
     
122. 
     
123. 
     
124. j = (UBound(fzpl.Coordinates) + 1) / 3
     
125. zbd1 = fzpl.Coordinate(j - 1)
     
126. ppploop:
     
127. i = i + 1
     
128. Loop
     
129. 
     
130. fzpl.Coordinates = blist
     
131. 
     
132. End Sub
     
133. 
     
134. 
     
135. 
     

<br /> <br /> Sub kkk1()<br /> Dim entry As AcadLineType<br />     Dim found As Boolean<br />     found = False<br />     For Each entry In ThisDrawing.Linetypes<br />         If StrComp(entry.Name, "acad_iso05w100", 1) = 0 Then<br />             found = True<br />             Exit For<br />         End If<br />     Next<br />     If Not (found) Then ThisDrawing.Linetypes.Load "acad_iso05w100", "acadiso.lin"<br />     <br />     <br />     <br /> Dim fzpl As AcadPolyline<br /> Dim zbd As Variant<br /> Dim zbd1 As Variant<br /> Dim startpoint As Variant<br /> Dim i As Integer<br /> Dim j As Integer<br /> Dim blist() As Double<br /> Dim lcx As AcadLayer<br /> Set lcx = ThisDrawing.Layers.Add("虚线层")<br /> lcx.Color = acCyan<br /> <br /> <br /> On Error Resume Next<br />      Dim keywordList As String<br />     keywordList = "Close Undo"<br />     <br />     <br /> Do<br /> If IsEmpty(zbd1) Then<br />   zbd = ThisDrawing.Utility.GetPoint(, "第一点:")<br /> <br />   startpoint = zbd<br />   Else<br /> restart:<br />   ThisDrawing.Utility.InitializeUserInput 128, keywordList<br />   zbd = ThisDrawing.Utility.GetPoint(zbd1, "下一点[闭合(C)/后退(U)]:")<br />         If Err Then<br />   <br />                     If Err.Number = -2147467259 Then<br />                             Dim inputString As String<br />                              Err.Clear<br />                              inputString = ThisDrawing.Utility.GetInput<br />                                     If inputString = "Close" Then<br />                                        fzpl.Closed = True<br />                                     End If<br />                                     If inputString = "Undo" Then<br />                                     i = i - 2<br />                                     If i = 0 Then<br />                                     <br />                                     fzpl.Delete<br />                                     zbd1 = startpoint<br />                                     blist(0) = zbd1(0)<br />                                     blist(1) = zbd1(1)<br />                                     blist(2) = zbd1(2)<br />                                     i = 1<br />                                     GoTo restart<br />                                     'End<br />                                     End If<br />                                     If i < 0 Then<br />                                     End<br />                                     End If<br />                                     ReDim Preserve blist(3 * i + 2)<br />                                     GoTo endundo<br />                                     End If<br />                                     <br />                                     <br />                                      Exit Do<br />                      End If<br />         End If<br />         <br />   End If<br /> <br />   If Err Then<br />           <br />                     Err.Clear<br />                     Exit Do<br />    <br />               <br />   End If<br />   ReDim Preserve blist(3 * i + 2)<br />   blist(3 * i) = zbd(0): blist(3 * i + 1) = zbd(1): blist(3 * i + 2) = zbd(2)<br /> <br />   If i = 0 Then<br />   zbd1 = zbd<br />   GoTo ppploop<br /> <br />   End If<br />   <br />   If i = 1 Then<br />   <br />   Dim start(0 To 5) As Double<br /> <br />   start(0) = blist(0)<br />   start(1) = blist(1)<br />   start(2) = blist(2)<br />   start(3) = blist(3)<br />   start(4) = blist(4)<br />   start(5) = blist(5)<br />   <br />   Set fzpl = ThisDrawing.ModelSpace.AddPolyline(start)<br />   fzpl.Linetype = "acad_iso05w100"<br /> fzpl.Layer = "虚线层"<br /> fzpl.Update<br /> <br /> zbd1 = zbd<br />   GoTo ppploop<br />     <br />   End If<br />   <br /> endundo:<br /> <br />   fzpl.Coordinates = blist<br />   <br />   fzpl.Update<br /> <br /> <br /> j = (UBound(fzpl.Coordinates) + 1) / 3<br /> zbd1 = fzpl.Coordinate(j - 1)<br /> ppploop:<br /> i = i + 1<br /> Loop<br /> <br /> fzpl.Coordinates = blist<br /> <br /> End Sub<br /> <br /> <br /> <br />