VB和VBA关于创建CAD的选集

Dim adText As AcadText
    Dim adSS As AcadSelectionSet
    Dim fType(0 To 1) As Integer, fData(0 To 1)
    Dim i As Integer
        If lstFile.ListCount = 0 Then
        MsgBox "请添加所要操作的图形!"
        Exit Sub
    End If
       
    '打开图形进行操作
    For i = 0 To lstFile.ListCount
        Application.Documents.Open lstFile.List(i)
        
        On Error Resume Next
        frmMain.Hide
        '创建新选择集
        Set adSS = ThisDrawing.SelectionSets.Add("adSS")
        If Err Then Set adSS = ThisDrawing.SelectionSets.Add("adSS")
        adSS.Clear
    
        fType(0) = 0: fData(0) = "TEXT": fType(1) = 8: fData(1) = "*"
        adSS.Select acSelectionSetAll, , , fType, fData
    请高手解释上述代码的选择集如何控制
******************************************************************

Dim adText As AcadText
    Dim adMText As AcadMText
    Dim adSS As AcadSelectionSet
    Dim fType(0 To 1) As Integer, fData(0 To 1)
    Dim i As Integer
    
    If txtFind.Text = "" Or txtReplace.Text = "" Then
        MsgBox "输入所要替换的字符串内容!"
        Exit Sub
    End If
    If lstFile.ListCount = 0 Then
        MsgBox "请添加所要操作的图形!"
        Exit Sub
    End If
    
    '获得替换数据
    Dim strFind As String
    Dim strReplace As String
    strFind = txtFind
    strReplace = txtReplace
         
    '打开图形进行操作
    For i = 0 To lstFile.ListCount
        Application.Documents.Open lstFile.List(i)
        
        On Error Resume Next
        frmMain.Hide
        '创建新选择集
        Set adSS = ThisDrawing.SelectionSets.Add("adSS")
        If Err Then Set adSS = ThisDrawing.SelectionSets.Add("adSS")
        adSS.Clear
    
        fType(0) = 0: fData(0) = "TEXT": fType(1) = 8: fData(1) = "*"
        adSS.Select acSelectionSetAll, , , fType, fData
        '对单行文字完成多重文字替换
        For Each adText In adSS
            With adText
                If InStr(.TextString, strFind) Then .TextString = ReplaceStr(.TextString, strFind, strReplace, False)
            End With
        Next adText
    
        adSS.Clear
        fType(0) = 0: fData(0) = "MTEXT": fType(1) = 8: fData(1) = "*"
        adSS.Select acSelectionSetAll, , , fType, fData
        '对多行文字完成多重文字替换
        For Each adMText In adSS
            With adMText
                If InStr(.TextString, strFind) Then .TextString = ReplaceStr(.TextString, strFind, strReplace, False)
            End With
        Next adMText
    
        adSS.Delete
        ThisDrawing.Regen acAllViewports
        
        '关闭图形
        Application.ActiveDocument.Close True, lstFile.List(i)
    Next i

******************************************************************


Dim file As String
file = "e:\experimentation\EV-012.dwg"
Dim tttstr As String
Dim adss As AcadSelectionSe
mycad.Documents.Open file
Set adss = mycad.ActiveDocument.SelectionSets.Add("adss")
If Err Then Set adss = mycad.ActiveDocument.SelectionSets.Add("adss")
adss.Clear
Dim ftype(0 To 1) As Integer
Dim fdata(0 To 1) As Integer
ftype(0) = 0: fdata(0) = "text": ftype(1) = 8: fdata(1) = "*"
adss.Select acSelectionSetAll, , , ftype, fdata
Dim obj
Dim adtext As AcadText
  Dim find As String
  find = "123"
For Each adtext In adss
if adtext= find then
adtext.ScaleFactor = 1#
end if
next

*******************************************************************

Private Sub CommandButton1_Click()
On Error Resume Next
Dim FilterType(0) As Integer
Dim FilterData(0) As Variant
Dim AcadText As AcadEntity
Dim Sep As Integer
Dim Num As Integer
'设定条件
Dim AddText As AcadText
    FilterType(0) = 8
    FilterData(0) = "ZH"
    Dim Sset As AcadSelectionSet
                '安全创建选择集
        Do While ThisDrawing.SelectionSets.Count > 0
            ThisDrawing.SelectionSets.Item(0).Delete
        Loop
       
        Set Sset = ThisDrawing.SelectionSets.Add("sse1")
        Sset.Select acSelectionSetAll, , , FilterType, FilterData
            For Each AcadText In Sset
                'MsgBox TypeName(AcadText)
                If TypeName(AcadText) = "IAcadText" Then
                    Sep = InStr(AcadText.TextString, "+")
                    If Sep <> 0 Then
                        AcadText.TextString = Left(AcadText.TextString, Sep - 1) & "+" & Format(Mid(AcadText.TextString, Sep + 1), "0")
                       
                        Num = Num + 1
                    Else
                        AcadText.TextString = Format(AcadText.TextString, "0")
                        Num = Num + 1
                    End If
                End If
            Next
            MsgBox "一共修改了" & Num & "个", vbExclamation, "谢谢使用"
        'Sset.Erase
        Sset.Delete
                       
End Sub

  • 0
    点赞
  • 4
    收藏
    觉得还不错? 一键收藏
  • 打赏
    打赏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

yueliang2100

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值