如何用VBA达到以下效果
如何用VBA达到以下效果例:图形中用红线 白线 黄线 运行程序后,如何能够使红线处于选中状态,然后就可以用sendcommand对红线进行处理
试了很多次,都不成功,请大家指点 构建一选择集，采用过滤机制，将红线添加到选择集中。如：
fType(0)=62:fData(0)=acRed '仅选择红色
fType(1)=0:fData(1)="*Line" '所有直线，包括直线、多段线等
操作完成后，还可以对选中的每个实体用Highlight设置加亮状态，使它们看起来就象使用CAD内部选择命令一样。最后执行自己的命令对选择集进行操作。
谢谢,我的表述不清楚,现补充:
当程序得到红线后,对这些红线进行加粗为0.5,就需要利用sendcommand来发送pe命令,问题在于如何让pe命令知道要加粗的为这些红线,从而自动加粗,而不用手动一根一根的加粗为0.5
请朋友们抽空解答 "遍历选择集中的对象，然后进行操作"也就是说是先选择,后操作
但我用sendcommand来发送pe命令后,又提示让我选择物体,也就是说遍历到的红线(我想加粗的线)根本不被pe命令接受
而我的本意是在程序中事先设置好ThisDrawing.SendCommand "_pe" & vbCr & "y" & vbCr & "w" & vbCr & "1" & vbCr & vbCr 当遍历到该物体时,就对该红线自动执行加宽为1个单位
如果这次明白了我的意思,就请朋友们帮忙解决一下 Sub PE()
Dim ss As AcadSelectionSet
Set ss = GetSelSet
Dim Ent As AcadEntity
For Each Ent In ss
If Ent.ObjectName = "AcDbLine" Then
ThisDrawing.SendCommand "_pe" & vbCr _
& axEnt2lspEnt(Ent) & vbCr & "y" & vbCr & "w" _
& vbCr & "1" & vbCr & vbCr
End If
Next
End Sub
Function GetSelSet() As AcadSelectionSet
Dim ss As AcadSelectionSet
Set ss = ThisDrawing.PickfirstSelectionSet
If ss.Count = 0 Then
Dim ssName As String
ssName = "strSSet"
On Error Resume Next
Set ss = ThisDrawing.SelectionSets(ssName)
If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName)
ss.Clear
ss.SelectOnScreen
End If
Set GetSelSet = ss
End Function
Public Function axEnt2lspEnt(entObj As AcadEntity) As String
Dim entHandle As String
entHandle = entObj.Handle
axEnt2lspEnt = "(handent " & Chr(34) & entHandle & Chr(34) & ")"
End Function
页:
[1]