如何用VBA达到以下效果

chuqi26

如何用VBA达到以下效果
    例:图形中用红线 白线 黄线 运行程序后,如何能够使红线处于选中状态,然后就可以用sendcommand对红线进行处理
    试了很多次,都不成功,请大家指点

efan2000

构建一选择集，采用过滤机制，将红线添加到选择集中。如：
fType(0)=62:fData(0)=acRed '仅选择红色
fType(1)=0:fData(1)="*Line" '所有直线，包括直线、多段线等
操作完成后，还可以对选中的每个实体用Highlight设置加亮状态，使它们看起来就象使用CAD内部选择命令一样。最后执行自己的命令对选择集进行操作。

chuqi26

谢谢,我的表述不清楚,现补充:
              当程序得到红线后,对这些红线进行加粗为0.5,就需要利用sendcommand来发送pe命令,问题在于如何让pe命令知道要加粗的为这些红线,从而自动加粗,而不用手动一根一根的加粗为0.5
   
请朋友们抽空解答

mccad

chuqi26

"遍历选择集中的对象，然后进行操作"也就是说是先选择,后操作

但我用sendcommand来发送pe命令后,又提示让我选择物体,也就是说遍历到的红线(我想加粗的线)根本不被pe命令接受

而我的本意是在程序中事先设置好ThisDrawing.SendCommand "_pe" & vbCr & "y" & vbCr & "w" & vbCr & "1" & vbCr & vbCr 当遍历到该物体时,就对该红线自动执行加宽为1个单位

如果这次明白了我的意思,就请朋友们帮忙解决一下

mccad

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

chuqi26