请教一段VBA代码

陈琦

Sub Getusersselection()
Dim usersselection As AcadSelectionSet
Dim drawingselected As AcadEntity
With ThisDrawing
On Error Resume Next
.SelectionSets("currentselection").Delete
MsgBox "select objects !hit enter to finish!"
Set usersselection = ?
.SelectionSets.Add ("currentselection")
usersselection.SelectOnScreen
For Each drawingselected In usersselection
drawingselected.color = acGreen
Next
End With
End Sub

各位高手!小弟在此请教,该段代码的作用是在CAD模型空间选取直线进行变换颜色.

但代码中红色部分编译程序报错,我个人觉得也不符合格式,请问各位高手该段代码应该怎样修改.

weianhui

以下代码经过我测试,应该没问题的
Sub Getusersselection()
Dim usersselection As AcadSelectionSet
Dim drawingselected As AcadEntity
If ThisDrawing.SelectionSets.Count <> 0 Then
   Do While ThisDrawing.SelectionSets.Count <> 0
      ThisDrawing.SelectionSets.Item(0).Delete
   Loop
End If
MsgBox "select objects !hit enter to finish!"
Set usersselection = ThisDrawing.SelectionSets.Add("example")
usersselection.SelectOnScreen
For Each drawingselected In usersselection
         drawingselected.color = acGreen
Next
usersselection.Delete
End Sub

陈琦

谢谢大哥！小弟还有一个问题。大哥是否看过AUTOCADVBA从入门到精通这本书。在第150页的第13行命令，大哥是否能将代码发送上来，小弟用的是扫描书，看不请里面的标点。

陈琦

另大哥可否将QQ号等联系方式留给小弟，小弟初学有很多问题不懂，需请教！

woaishuijia

楼主代码输入有误，红色代码和它下面一行应为同一行：

Set usersselection = .SelectionSets.Add ("currentselection")

二楼的这段代码：

If ThisDrawing.SelectionSets.Count <> 0 Then
   Do While ThisDrawing.SelectionSets.Count <> 0
      ThisDrawing.SelectionSets.Item(0).Delete
   Loop
End If

改为这样是不是更简单些？

Do Until ThisDrawing.SelectionSets.Count = 0
   ThisDrawing.SelectionSets.Item(0).Delete
Loop