cad选择集的问题（VBA ）

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

cad选择集的问题（VBA ）相关推荐

【CAD二次开发】CAD选择集的问题集合
var result = ed.SelectCrossingWindow();获取指定范围内的对象,类似从右下角到左上角框选: 注意框选对象要在CAD的窗体范围内,否则会返回错误结果.
cad怎么选择一个对象打散vba_CADVBA中的选择集过滤.doc
CAD中的选择集过滤一.选择集过滤时的使用方式如下: Object 指使用SelectionSet这个方法适用的对象 1)????? object.Select Mode[, Point1][, P ...
CAD二次开发(c#)利用选择集获取标注尺寸
1.目的本文的目的是利用C#中选择集GetSelection函数得到CAD中标注尺寸 2.实现代码 using Autodesk.AutoCAD.ApplicationServices; using ...
AutoCAD VBA 通过选择集删除图层上所有对象和图层
AutoCAD VBA 通过选择集删除图层上所有对象和图层 '删除图层上所有对象 Function DelAllInLayer(ByVal LName As String) 'On Erro ...
CAD中的选择集过滤----有条件选择AutoCAD实体
转载自:http://www.cnblogs.com/jdmei520/articles/1326120.html 一.选择集过滤时的使用方式如下: Object 指使用SelectionSet这个方 ...
C#之CAD二次开发(10) 用户交互之选择集
# 0. 前言 CAD中通过用户交互来选择对象,也可以通过.NET API模拟不同对象选择选项. 当执行多个选择集时,可以创建一个ObjectIdCollection对象来跟踪已选择的对象. 可以用如 ...
CAD开发——AcadSelectionSet 选择集
1. 定义一个永不重复的时间变量 Private Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMT ...
AutoCAD VBA选择集操作
AutoCAD VBA选择集操作,示例代码如下. Public Sub Test() Dim pt1(0 To 2) As Double Dim pt2(0 To 2) As Double Dim p ...
基于C#的AutoCAD二次开发之获取用户输入信息、选择集、访问CAD内部命令
基于C#的AutoCAD二次开发之获取用户输入信息.选择集.访问CAD内部命令在CAD创建图形对象时,经常需要和用户进行交互,例如:直线创建时需要用户输入起点和终点(或长度)信息,复制对象时需要指定 ...

cad选择集的问题（VBA ）

cad选择集的问题（VBA ）相关推荐

最新文章

热门文章