怎样用VB实现…………

tukuitk

明总，你冤枉我了。：）
我写了，写不出来了，上面写的我怀疑有错。就是判断条件时我觉得有错。
我想编程，也爱好它。但我很菜的。：）

tukuitk

各位大虾：
请问，用VB与ACAD连接后可用语句如：ThisDrawing.SelectionSets(ssName)吗？

leeyeafu

用VB与ACAD连接主，没有ThisDrawing对象，在VB中你应该有一个AutoCAD.Application对象，假设为AcadApp，在程序中你可以用AcadApp.ActiveDocument代替ThisDrawing对象。

tukuitk

谢谢leeyeafu版主！我再去试试……

tukuitk

用Set AcadDoc = AcadApp.ActiveDocument后
AcadDoc在本工程中都能运用吧？

leeyeafu

你自己应该可以判断吧？可以那样做

tukuitk

版主：
我在VB中运行这个：
Sub krSwap()
    Set ssetObj = AcadDoc.SelectionSets.Add("SSET")
    Dim ArrayData As Variant

    Dim mode As Integer
    Dim FilterType(5) As Integer
    Dim FilterData(5) As Variant
   
    FilterType(0) = -4
    FilterData(0) = "<OR"
    FilterType(1) = 0
    FilterData(1) = "MTEXT"
    FilterType(2) = 0
    FilterData(2) = "TEXT"
    FilterType(3) = 0
    FilterData(3) = "INSERT"
    FilterType(4) = 0
    FilterData(4) = "ATTDEF"
    FilterType(5) = 0
    FilterData(5) = "OR>"
    Dim acSelectionSetAll As Integer
    mode = acSelectionSetAll
   
    ssetObj.Select mode, FilterType, FilterData
   
     Dim ent As Object
     Dim j As Integer
     
     For Each ent In ssetObj
     
With ent
' 发现块参考时，检查其属性
  If StrComp(.EntityName, "acdbblockreference", 1) = 0 Then
    If .HasAttributes Then
     '取得属性值
    ArrayData = .GetAttributes
    Dim appcount As Integer
        For appcount = LBound(ArrayData) To UBound(ArrayData)
           If StrComp(ArrayData(appcount).EntityName, "acdbattribute", 1) = 0 Then
            ArrayData(appcount).TagString = ReplaceString(ArrayData(appcount).TagString, oldTxt.Text, newTxt.Text)
            ArrayData(appcount).TextString = ReplaceString(ArrayData(appcount).TextString, oldTxt.Text, newTxt.Text)
           End If
        Next appcount
    End If
  End If
End With
         
     Next ent
      
End Sub
提示我说：对象‘Select’的方法'IAcadSelectionSet'失败
在创建选择集时出错，该怎么修改呢？
Help me！！！！

tukuitk

我又改为如下了，还是不行，为什么呢？
Sub krSwap()
     Dim ent As Object
     Dim j As Integer
     Dim ArrayData As Variant
     
     For Each ent In mPace
With ent
' 发现块参考时，检查其属性
  If StrComp(.EntityName, "acdbblockreference", 1) = 0 Then
    If .HasAttributes Then
     '取得属性值
    ArrayData = .GetAttributes
    Dim appcount As Integer
        For appcount = LBound(ArrayData) To UBound(ArrayData)
           If StrComp(ArrayData(appcount).EntityName, "acdbattribute", 1) = 0 Then
            ArrayData(appcount).TagString = ReplaceString(ArrayData(appcount).TagString, oldTxt.Text, newTxt.Text)
            ArrayData(appcount).TextString = ReplaceString(ArrayData(appcount).TextString, oldTxt.Text, newTxt.Text)
           End If
        Next appcount
    End If
  End If
End With
     Next ent
      
End Sub

tukuitk

大虾们都到哪去了呢？
帮帮忙讪。谢谢！

leeyeafu

看来楼主也已经努力过了，我将我写的代码帖出来。
Sub SwapStr()
  Dim i As Integer
  Dim Ent As AcadEntity
  Dim ssel As AcadSelectionSet
  Dim ArrAttr() As AcadAttribute '声明一个属性数组存放图块属性
    '当然也可象你做的那样声明为Variant，不过那样程序要使用动态内存分配，
    '效率不如直接声明为已知类型
  
  '以下是避免选择集对象构造错误的常用方法，注意学习
  On Error Resume Next   '若遇到选择集构造错误，暂时允许程序强行通过
  Set ssel = ThisDrawing.SelectionSets.Add("ssel")
  If Err Then    '若遇到选择集构造错误
    Err.Clear   '清除错误信息
    Set ssel = ThisDrawing.SelectionSets.Item("ssel") '直接使用已经构造的选择集对象
  End If
  On Error GoTo 0   '恢复程序错误处理方式
  
  ssel.SelectOnScreen
  For Each Ent In ssel
    Select Case Ent.ObjectName
      Case "AcDbText", "AcDbMText":
        Ent.TextString = ReplaceString(Ent.TextString, "ABC", "XYZ")
      Case "AcDbBlockReference":
        If Ent.HasAttributes Then
        ArrAttr = Ent.GetAttributes
        For i = LBound(ArrAttr) To UBound(ArrAttr)
          ArrAttr(i).TagString = ReplaceString(ArrAttr(i).TagString, "ABC", "XYZ")
          ArrAttr(i).TextString = ReplaceString(ArrAttr(i).TextString, "ABC", "XYZ")
        Next i
        End If
      Case Else:
       '若还要处理其它类型对象，在这添加代码
    End Select
Next Ent

ssel.Delete '最好不要忘记及时删除ssel选择集对象
ThisDrawing.Application.Update
End Sub