用SendCommand执行cad命令，获得生成的图元对象

zzyong00

用SendCommand执行cad命令，获得生成的图元对象的方法一般是用ModelSpace的对象数量索引(ThisDrawing.ModelSpace.Count）来取得，
好像一般新生成的对象，在ModelSpace中的索引，都是排在最后(我没从官方文档中看到这个描述），取得方法：
Dim oEnt as AcadEntity
Set oEnt = ThisDrawing.ModelSpace(ThisDrawing.ModelSpace.Count - 1)
如果执行一个命令，生成的对象比较多，哪么在执行cad命令前记录一下ThisDrawing.ModelSpace.Count ，在执行后再记录一下ThisDrawing.ModelSpace.Count ，就可以把取得所有生成的对象了．
但我觉得以上方法，在一些特定的情况下，可能会有问题，所以，我一般采用我自己的方法，现在介绍一下我自己的方法：利用documment的事件．
直接上代码：

1. Option Explicit
   
2. 'By zzyong00 原创
   
3. Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
   
4. 
   
5. 
   
6. 
   
7. 
   
8. 'AutoCAD的documment对象的事件类，专门为用sendcommand产生的对象使用
   
9. Public WithEvents Document As AcadDocument
   
10. 
    
11. 
    
12. Public colEntityHandle     As Collection                    '保存更改的对象的handle
    
13. Public EvalCmd As String '设置正在执行的命令
    
14. Private EvalStatus As Boolean '标志命令执行的情况，是否完成，已完成为true
    
15. Private Sub Class_Initialize()
    
16.     Set colEntityHandle = New Collection                    '保存更改的对象的handle
    
17.     EvalStatus = False
    
18. End Sub
    
19. 
    
20. 
    
21. Private Sub Document_EndCommand(ByVal CommandName As String)
    
22.     If LCase(CommandName) = LCase(EvalCmd) Then EvalStatus = True
    
23. End Sub
    
24. 
    
25. 
    
26. Private Sub Document_ObjectModified(ByVal Object As Object)                     '将图中更改的对象handle添加到集合中
    
27.    
    
28.     'Debug.Print "Modify:", TypeName(Object), Object.Handle
    
29.     If Not TypeName(Object) = "IAcadModelSpace" Then colEntityHandle.Add Object.Handle
    
30. End Sub
    
31. Public Sub ClearEntityHandleCol()                           '每用完一次，都得清理一下，才能保证是每执行一个命令，集合保存的是最新改变的对象handle
    
32.    
    
33.     Dim i As Long
    
34.    
    
35.     For i = colEntityHandle.Count To 1 Step -1
    
36.         colEntityHandle.Remove 1
    
37.     Next
    
38.    
    
39. End Sub
    
40. Public Function IsExistHandle(ByVal strH As String) As Boolean '判断一个handle是否存在真的对象
    
41.     On Error GoTo err1
    
42.     Dim objEnt As AcadObject
    
43.     Set objEnt = Document.HandleToObject(strH)
    
44.     IsExistHandle = True
    
45.     Exit Function
    
46. err1:
    
47.     IsExistHandle = False
    
48.     Err.Clear
    
49. End Function
    
50. 
    
51. 
    
52. Public Sub ClearInvalidHandle() '清除掉无效的句柄，对象已被删除
    
53.     Dim j As Long
    
54.     For j = colEntityHandle.Count To 1 Step -1
    
55.         If Not IsExistHandle(colEntityHandle(j)) Then
    
56.             colEntityHandle.Remove j
    
57.         End If
    
58.     Next j
    
59. End Sub
    
60. 
    
61. 
    
62. Public Sub WaitForEvalCmdComplete()
    
63.     Do
    
64.         Sleep 1
    
65.         DoEvents
    
66.     Loop Until EvalStatus = True
    
67.     EvalStatus = False
    
68. End Sub
    

Option Explicit<br /> 'By zzyong00 原创<br /> Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)<br /> <br /> <br /> <br /> <br /> '<a href="http://bbs.mjtd.com/forum-41-1.html" target="_blank" class="relatedlink">AutoCAD</a>的documment对象的事件类，专门为用sendcommand产生的对象使用<br /> Public WithEvents Document As AcadDocument<br /> <br /> <br /> Public colEntityHandle     As Collection                    '保存更改的对象的handle<br /> Public EvalCmd As String '设置正在执行的命令<br /> Private EvalStatus As Boolean '标志命令执行的情况，是否完成，已完成为true<br /> Private Sub Class_Initialize()<br />     Set colEntityHandle = New Collection                    '保存更改的对象的handle<br />     EvalStatus = False<br /> End Sub<br /> <br /> <br /> Private Sub Document_EndCommand(ByVal CommandName As String)<br />     If LCase(CommandName) = LCase(EvalCmd) Then EvalStatus = True<br /> End Sub<br /> <br /> <br /> Private Sub Document_ObjectModified(ByVal Object As Object)                     '将图中更改的对象handle添加到集合中<br />     <br />     'Debug.Print "Modify:", TypeName(Object), Object.Handle<br />     If Not TypeName(Object) = "IAcadModelSpace" Then colEntityHandle.Add Object.Handle<br /> End Sub<br /> Public Sub ClearEntityHandleCol()                           '每用完一次，都得清理一下，才能保证是每执行一个命令，集合保存的是最新改变的对象handle<br />     <br />     Dim i As Long<br />     <br />     For i = colEntityHandle.Count To 1 Step -1<br />         colEntityHandle.Remove 1<br />     Next<br />     <br /> End Sub<br /> Public Function IsExistHandle(ByVal strH As String) As Boolean '判断一个handle是否存在真的对象<br />     On Error GoTo err1<br />     Dim objEnt As AcadObject<br />     Set objEnt = Document.HandleToObject(strH)<br />     IsExistHandle = True<br />     Exit Function<br /> err1:<br />     IsExistHandle = False<br />     Err.Clear<br /> End Function<br /> <br /> <br /> Public Sub ClearInvalidHandle() '清除掉无效的句柄，对象已被删除<br />     Dim j As Long<br />     For j = colEntityHandle.Count To 1 Step -1<br />         If Not IsExistHandle(colEntityHandle(j)) Then<br />             colEntityHandle.Remove j<br />         End If<br />     Next j<br /> End Sub<br /> <br /> <br /> Public Sub WaitForEvalCmdComplete()<br />     Do<br />         Sleep 1<br />         DoEvents<br />     Loop Until EvalStatus = True<br />     EvalStatus = False<br /> End Sub<br /> <font style="font-size:14px">

上面代码是我的clsDocumentEvent.cls类，其利用Document_ObjectModified获取修改或生成的对象，Document_EndCommand确认命令执行结束．
以下，测试一下extend和boundary命令：

1. Option Explicit
   
2. 'By zzyong00 原创
   
3. 
   
4. 
   
5. Private Sub MyExtend(objPL1 As AcadObject, objPL2 As AcadObject) '延长命令
   
6.     'objPL1 延长的目标
   
7.     'objPL2 要延长的线
   
8.     Dim objDoc As AcadDocument
   
9.     Set objDoc = ThisDrawing
   
10.     Dim objCls      As New clsDocumentEvent
    
11.     If objPL1.ObjectName = "AcDbPolyline" And objPL2.ObjectName = "AcDbPolyline" Then
    
12.         Set objCls.Document = objDoc
    
13.         objCls.EvalCmd = "extend"
    
14. 
    
15. 
    
16.         objDoc.SendCommand "_extend" & vbCr & "(handent """ & objPL1.Handle & """)" & vbCr & vbCr & "(handent """ & objPL2.Handle & """)" & vbCr & vbCr  '不同autocad版本，命令格式可能稍有不同
    
17. 
    
18. 
    
19.         objCls.WaitForEvalCmdComplete
    
20.         objCls.ClearInvalidHandle
    
21.     End If
    
22.     Dim i As Long, objEnt As AcadEntity, objNewPl As AcadLWPolyline
    
23.     Dim objColor As AcadAcCmColor
    
24.     Set objColor = objCad.GetInterfaceObject("AutoCAD.AcCmColor." & Left$(objCad.Version, 2))
    
25.     objColor.ColorIndex = acBlue
    
26.     If objCls.colEntityHandle.Count >= 1 Then
    
27.         For i = 1 To objCls.colEntityHandle.Count
    
28.             Set objEnt = objDoc.HandleToObject(objCls.colEntityHandle.Item(i))
    
29.             If objEnt.ObjectName = "AcDbPolyline" Then
    
30. 
    
31. 
    
32.                 Set objNewPl = objEnt   '在这儿，我们获取到了执行命令后变化的对象
    
33.                 '                    Debug.Print objNewPl.Length
    
34.                 objNewPl.TrueColor = objColor    '把它颜色改成蓝色
    
35.             End If
    
36.         Next i
    
37.     End If
    
38. 
    
39. 
    
40.     Set objCls.Document = Nothing
    
41.     objCls.ClearEntityHandleCol
    
42. End Sub
    
43. 
    
44. 
    
45. Private Sub MyBoundary(Pt1 As Variant, strObjHdl As String)
    
46.     '---------------------------
    
47.     '    If VarType(pt1) <> vbEmpty Then
    
48.     '    If UBound(pt1) >= 1 Then
    
49.     '        strCmd = "-boundary" & vbCr & "a" & vbCr & "o" & vbCr & "p" & vbCr & "i" & vbCr & "y" & vbCr & "b" & vbCr & "n" & _
    
50.         '        vbCr & strObjHdl & vbCr & vbCr & pt1(0) & "," & pt1(1) & vbCr & vbCr
    
51.     '        'strObjHdl="(handent """ & objB.Handle & """)" & vbCr & "(handent """ & objPL.Handle & """)" & vbCr
    
52.     '    End If
    
53.     '
    
54.     '    Debug.Print strCmd
    
55.     '    ThisDrawing.SendCommand strCmd
    
56.     '-----------------------
    
57.     '以前版本
    
58. 
    
59. 
    
60.     Static lcount As Long
    
61. 
    
62. 
    
63.     Dim strCmd    As String
    
64. 
    
65. 
    
66.     If lcount = 0 Then
    
67.         If VarType(Pt1) <> vbEmpty Then
    
68.             If UBound(Pt1) >= 1 Then
    
69.                 '                strCmd = "-boundary" & vbCr & "a" & vbCr & "o" & vbCr & "p" & vbCr & _
    
70.                     '                vbCr & pt1(0) & "," & pt1(1) & vbCr & vbCr
    
71.                 strCmd = "-boundary" & vbCr & "a" & vbCr & "o" & vbCr & "p" & vbCr & "i" & vbCr & "y" & vbCr & "b" & vbCr & "n" & _
    
72.                          vbCr & strObjHdl & vbCr & vbCr & Pt1(0) & "," & Pt1(1) & vbCr & vbCr
    
73.                 'strObjHdl="(handent """ & objB.Handle & """)" & vbCr & "(handent """ & objPL.Handle & """)" & vbCr
    
74.             End If
    
75. 
    
76. 
    
77.             'Debug.Print strCmd
    
78.             ThisDrawing.SendCommand strCmd
    
79.             lcount = 1
    
80.         End If
    
81. 
    
82. 
    
83.     Else
    
84. 
    
85. 
    
86.         If VarType(Pt1) <> vbEmpty Then
    
87.             If UBound(Pt1) >= 1 Then
    
88.                 strCmd = "-boundary" & vbCr & "a" & vbCr & "b" & vbCr & "n" & vbCr & strObjHdl & vbCr & vbCr & Pt1(0) & "," & Pt1(1) & vbCr & vbCr
    
89.             End If
    
90. 
    
91. 
    
92.             'Debug.Print strCmd
    
93.             ThisDrawing.SendCommand strCmd
    
94.         End If
    
95.     End If
    
96. 
    
97. 
    
98. End Sub
    
99. 
    
100. 
     
101. Private Sub Boundary() '测试Boundary用
     
102.     On Error GoTo err1
     
103. 
     
104. 
     
105.     Dim pt  As Variant
     
106.     Dim objDoc As AcadDocument
     
107.     Set objDoc = ThisDrawing
     
108.     pt = objDoc.Utility.GetPoint(, "请指定封闭区间内一点：")
     
109. 
     
110. 
     
111.     Dim objCls      As New clsDocumentEvent
     
112.     Set objCls.Document = objDoc '关联Document对象和clsDocumentEvent对象
     
113.     objCls.EvalCmd = "-boundary"  '传递要用sendcommand执行的cad命令
     
114.     MyBoundary pt, ""             'sendcommand 执行cad命令
     
115.     objCls.WaitForEvalCmdComplete  '等待cad命令执行完
     
116.     objCls.ClearInvalidHandle      '清除某些命令的临时产物，有些cad命令在执行过程中，会产生临时的cad对象，最后系统又会把它们删掉，所以要剔除这样的对象句柄
     
117.     '从objCls.colEntityHandle集合中提取执行cad命令生成的对象．
     
118.     Dim objEnt As AcadEntity, i As Long, objNewPl() As AcadLWPolyline, lngPl_count As Long
     
119.     If objCls.colEntityHandle.Count >= 1 Then
     
120.         lngPl_count = 0
     
121.         For i = 1 To objCls.colEntityHandle.Count
     
122. 
     
123. 
     
124.             Set objEnt = objDoc.HandleToObject(objCls.colEntityHandle.Item(i))
     
125.             If objEnt.ObjectName = "AcDbPolyline" Then
     
126.                 ReDim objNewPl(lngPl_count)
     
127.                 Set objNewPl(lngPl_count) = objEnt
     
128.                 'Debug.Print objNewPl(lngPl_count).Coordinate(0)(0), objNewPl( _
     
129.                     lngPl_count).Coordinate(0)(1)
     
130.                 lngPl_count = lngPl_count + 1
     
131.             End If
     
132. 
     
133. 
     
134.         Next i
     
135.     End If
     
136.     Set objCls = Nothing
     
137.     Dim objColor As AcadAcCmColor
     
138.     Set objColor = objCad.GetInterfaceObject("AutoCAD.AcCmColor." & Left$(objCad.Version, 2))
     
139.     objColor.ColorIndex = acGreen
     
140. 
     
141. 
     
142.     If lngPl_count >= 1 Then
     
143.         For i = 0 To UBound(objNewPl)
     
144.             objNewPl(i).TrueColor = objColor
     
145.             MsgBox "封闭区域面积为：" & objNewPl(i).Area
     
146.         Next i
     
147.     End If
     
148.     Exit Sub
     
149. err1:
     
150.     Debug.Print Err.Description
     
151. End Sub
     
152. 
     
153. 
     
154. Private Sub Command1_Click()
     
155.     AppActivate objCad.Caption
     
156.     Dim objPL1 As AcadLWPolyline, objPL2 As AcadLWPolyline
     
157.     Dim blnESC As Boolean
     
158.     SelectPl objPL1, blnESC
     
159.     If blnESC Then Exit Sub
     
160.     SelectPl objPL2, blnESC
     
161.     If blnESC Then Exit Sub
     
162. 
     
163. 
     
164.     MyExtend objPL1, objPL2
     
165. 
     
166. 
     
167. End Sub
     
168. 
     
169. 
     
170. Private Sub Command2_Click()
     
171.     AppActivate objCad.Caption
     
172. 
     
173. 
     
174.     Boundary
     
175. End Sub
     
176. 
     
177. 
     
178. Private Sub Form_Load()
     
179.     ConnectAutoCAD
     
180. End Sub
     
181. 
     
182. 
     
183. Private Sub SelectPl(returnObj As AcadLWPolyline, blnESC As Boolean)
     
184.     Dim basePnt As Variant
     
185.     On Error Resume Next
     
186. 
     
187. 
     
188. RETRY:
     
189.     ThisDrawing.Utility.GetEntity returnObj, basePnt, "请选择pl线："
     
190.     ' Debug.Print Err.Number, Err.Description
     
191. 
     
192. 
     
193.     If Err.Number = -2147352567 Then
     
194.         blnESC = True
     
195.         Exit Sub
     
196.     End If
     
197. 
     
198. 
     
199.     If Err <> 0 Then
     
200.         Err.Clear
     
201.         GoTo RETRY
     
202.     Else
     
203.         returnObj.Highlight True
     
204.     End If
     
205. End Sub
     

Option Explicit<br /> 'By zzyong00 原创<br /> <br /> <br /> Private Sub MyExtend(objPL1 As AcadObject, objPL2 As AcadObject) '延长命令<br />     'objPL1 延长的目标<br />     'objPL2 要延长的线<br />     Dim objDoc As AcadDocument<br />     Set objDoc = ThisDrawing<br />     Dim objCls      As New clsDocumentEvent<br />     If objPL1.ObjectName = "AcDbPolyline" And objPL2.ObjectName = "AcDbPolyline" Then<br />         Set objCls.Document = objDoc<br />         objCls.EvalCmd = "extend"<br /> <br /> <br />         objDoc.SendCommand "_extend" & vbCr & "(handent """ & objPL1.Handle & """)" & vbCr & vbCr & "(handent """ & objPL2.Handle & """)" & vbCr & vbCr  '不同autocad版本，命令格式可能稍有不同<br /> <br /> <br />         objCls.WaitForEvalCmdComplete<br />         objCls.ClearInvalidHandle<br />     End If<br />     Dim i As Long, objEnt As AcadEntity, objNewPl As AcadLWPolyline<br />     Dim objColor As AcadAcCmColor<br />     Set objColor = objCad.GetInterfaceObject("AutoCAD.AcCmColor." & Left$(objCad.Version, 2))<br />     objColor.ColorIndex = acBlue<br />     If objCls.colEntityHandle.Count >= 1 Then<br />         For i = 1 To objCls.colEntityHandle.Count<br />             Set objEnt = objDoc.HandleToObject(objCls.colEntityHandle.Item(i))<br />             If objEnt.ObjectName = "AcDbPolyline" Then<br /> <br /> <br />                 Set objNewPl = objEnt   '在这儿，我们获取到了执行命令后变化的对象<br />                 '                    Debug.Print objNewPl.Length<br />                 objNewPl.TrueColor = objColor    '把它颜色改成蓝色<br />             End If<br />         Next i<br />     End If<br /> <br /> <br />     Set objCls.Document = Nothing<br />     objCls.ClearEntityHandleCol<br /> End Sub<br /> <br /> <br /> Private Sub MyBoundary(Pt1 As Variant, strObjHdl As String)<br />     '---------------------------<br />     '    If VarType(pt1) <> vbEmpty Then<br />     '    If UBound(pt1) >= 1 Then<br />     '        strCmd = "-boundary" & vbCr & "a" & vbCr & "o" & vbCr & "p" & vbCr & "i" & vbCr & "y" & vbCr & "b" & vbCr & "n" & _<br />         '        vbCr & strObjHdl & vbCr & vbCr & pt1(0) & "," & pt1(1) & vbCr & vbCr<br />     '        'strObjHdl="(handent """ & objB.Handle & """)" & vbCr & "(handent """ & objPL.Handle & """)" & vbCr<br />     '    End If<br />     '<br />     '    Debug.Print strCmd<br />     '    ThisDrawing.SendCommand strCmd<br />     '-----------------------<br />     '以前版本<br /> <br /> <br />     Static lcount As Long<br /> <br /> <br />     Dim strCmd    As String<br /> <br /> <br />     If lcount = 0 Then<br />         If VarType(Pt1) <> vbEmpty Then<br />             If UBound(Pt1) >= 1 Then<br />                 '                strCmd = "-boundary" & vbCr & "a" & vbCr & "o" & vbCr & "p" & vbCr & _<br />                     '                vbCr & pt1(0) & "," & pt1(1) & vbCr & vbCr<br />                 strCmd = "-boundary" & vbCr & "a" & vbCr & "o" & vbCr & "p" & vbCr & "i" & vbCr & "y" & vbCr & "b" & vbCr & "n" & _<br />                          vbCr & strObjHdl & vbCr & vbCr & Pt1(0) & "," & Pt1(1) & vbCr & vbCr<br />                 'strObjHdl="(handent """ & objB.Handle & """)" & vbCr & "(handent """ & objPL.Handle & """)" & vbCr<br />             End If<br /> <br /> <br />             'Debug.Print strCmd<br />             ThisDrawing.SendCommand strCmd<br />             lcount = 1<br />         End If<br /> <br /> <br />     Else<br /> <br /> <br />         If VarType(Pt1) <> vbEmpty Then<br />             If UBound(Pt1) >= 1 Then<br />                 strCmd = "-boundary" & vbCr & "a" & vbCr & "b" & vbCr & "n" & vbCr & strObjHdl & vbCr & vbCr & Pt1(0) & "," & Pt1(1) & vbCr & vbCr<br />             End If<br /> <br /> <br />             'Debug.Print strCmd<br />             ThisDrawing.SendCommand strCmd<br />         End If<br />     End If<br /> <br /> <br /> End Sub<br /> <br /> <br /> Private Sub Boundary() '测试Boundary用<br />     On Error GoTo err1<br /> <br /> <br />     Dim pt  As Variant<br />     Dim objDoc As AcadDocument<br />     Set objDoc = ThisDrawing<br />     pt = objDoc.Utility.GetPoint(, "请指定封闭区间内一点：")<br /> <br /> <br />     Dim objCls      As New clsDocumentEvent<br />     Set objCls.Document = objDoc '关联Document对象和clsDocumentEvent对象<br />     objCls.EvalCmd = "-boundary"  '传递要用sendcommand执行的cad命令<br />     MyBoundary pt, ""             'sendcommand 执行cad命令<br />     objCls.WaitForEvalCmdComplete  '等待cad命令执行完<br />     objCls.ClearInvalidHandle      '清除某些命令的临时产物，有些cad命令在执行过程中，会产生临时的cad对象，最后系统又会把它们删掉，所以要剔除这样的对象句柄<br />     '从objCls.colEntityHandle集合中提取执行cad命令生成的对象．<br />     Dim objEnt As AcadEntity, i As Long, objNewPl() As AcadLWPolyline, lngPl_count As Long<br />     If objCls.colEntityHandle.Count >= 1 Then<br />         lngPl_count = 0<br />         For i = 1 To objCls.colEntityHandle.Count<br /> <br /> <br />             Set objEnt = objDoc.HandleToObject(objCls.colEntityHandle.Item(i))<br />             If objEnt.ObjectName = "AcDbPolyline" Then<br />                 ReDim objNewPl(lngPl_count)<br />                 Set objNewPl(lngPl_count) = objEnt<br />                 'Debug.Print objNewPl(lngPl_count).Coordinate(0)(0), objNewPl( _<br />                     lngPl_count).Coordinate(0)(1)<br />                 lngPl_count = lngPl_count + 1<br />             End If<br /> <br /> <br />         Next i<br />     End If<br />     Set objCls = Nothing<br />     Dim objColor As AcadAcCmColor<br />     Set objColor = objCad.GetInterfaceObject("AutoCAD.AcCmColor." & Left$(objCad.Version, 2))<br />     objColor.ColorIndex = acGreen<br /> <br /> <br />     If lngPl_count >= 1 Then<br />         For i = 0 To UBound(objNewPl)<br />             objNewPl(i).TrueColor = objColor<br />             MsgBox "封闭区域面积为：" & objNewPl(i).Area<br />         Next i<br />     End If<br />     Exit Sub<br /> err1:<br />     Debug.Print Err.Description<br /> End Sub<br /> <br /> <br /> Private Sub Command1_Click()<br />     AppActivate objCad.Caption<br />     Dim objPL1 As AcadLWPolyline, objPL2 As AcadLWPolyline<br />     Dim blnESC As Boolean<br />     SelectPl objPL1, blnESC<br />     If blnESC Then Exit Sub<br />     SelectPl objPL2, blnESC<br />     If blnESC Then Exit Sub<br /> <br /> <br />     MyExtend objPL1, objPL2<br /> <br /> <br /> End Sub<br /> <br /> <br /> Private Sub Command2_Click()<br />     AppActivate objCad.Caption<br /> <br /> <br />     Boundary<br /> End Sub<br /> <br /> <br /> Private Sub Form_Load()<br />     ConnectAutoCAD<br /> End Sub<br /> <br /> <br /> Private Sub SelectPl(returnObj As AcadLWPolyline, blnESC As Boolean)<br />     Dim basePnt As Variant<br />     On Error Resume Next<br /> <br /> <br /> RETRY:<br />     ThisDrawing.Utility.GetEntity returnObj, basePnt, "请选择pl线："<br />     ' Debug.Print Err.Number, Err.Description<br /> <br /> <br />     If Err.Number = -2147352567 Then<br />         blnESC = True<br />         Exit Sub<br />     End If<br /> <br /> <br />     If Err <> 0 Then<br />         Err.Clear<br />         GoTo RETRY<br />     Else<br />         returnObj.Highlight True<br />     End If<br /> End Sub<br /> <font style="font-size:14px">

最后，把完整vb6工程上传：

Zzllvb

虽然不咋喜欢用SendCommand 但为大神点赞

pengfei2010

回帖是一种美德！感谢楼主的无私分享 谢谢

wit0708

请教版主，写了一个VBA的命令是想通过VBA调用CAD的的arraypath沿路径阵列的命令。在VBA编辑器下运行时，一切正常；但是用CAD的VBARUN，运行test过程的时候，在第二次“SendCommand”就出现“运行时错误执行环境无效”，请帮忙诊断一下问题的原因

wit0708

Public Sub test()

   Dim I
   Dim n
   Dim po(1 To 3) '阵列长度
   n = 3
    po(1) = 1
    po(2) = 2
    po(3) = 3
  

Dim p1 As Variant
p1 = ThisDrawing.Utility.GetPoint(, "选择基点位置:") '点选基底位置坐标
Dim path1 As AcadEntity
Dim pnt As Variant
ThisDrawing.Utility.GetEntity path1, pnt, "选择路径:" '沿此路径阵列
'绘制一条直线，与基点相关
Dim line1 As AcadLine
Dim line4 As AcadLine
Dim startPoint(0 To 2) As Double
Dim endPoint(0 To 2) As Double
startPoint(0) = p1(0): startPoint(1) = p1(1) - 1.6: startPoint(2) = p1(2)
endPoint(0) = p1(0): endPoint(1) = p1(1) + 1.6: endPoint(2) = p1(2)

Set line1 = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)


Dim strr(12)
strr(0) = "_arraypath"
strr(1) = GetDoubleEntTable(line1, pnt)
strr(3) = GetDoubleEntTable(path1, pnt)
strr(4) = "as"
strr(5) = "N"
strr(6) = "I"
strr(8) = 2
strr(9) = "A"
strr(10) = "Y"
strr(11) = "x"


strr(7) = po(1)

ThisDrawing.SendCommand Join(strr, vbCr)

strr(7) = po(2)

ThisDrawing.SendCommand Join(strr, vbCr) '运行到此处出错

End Sub

'转换双元表的函数
Public Function GetDoubleEntTable(entobj As AcadEntity, pnt As Variant) As String
Dim entHandle As String
entHandle = entobj.Handle
GetDoubleEntTable = "(list(handent " & Chr(34) & entHandle & Chr(34) & ")(list " & Str(pnt(0)) & Str(pnt(1)) & Str(pnt(2)) & "))"
End Function