tukuitk 发表于 2003-10-20 09:06:00

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

tukuitk 发表于 2003-10-20 11:24:00

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

leeyeafu 发表于 2003-10-20 11:32:00

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

tukuitk 发表于 2003-10-20 12:17:00

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

tukuitk 发表于 2003-10-20 12:51:00

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

leeyeafu 发表于 2003-10-20 12:55:00

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

tukuitk 发表于 2003-10-20 14:06:00

版主：
我在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 发表于 2003-10-20 16:50:00

我又改为如下了，还是不行，为什么呢？
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 发表于 2003-10-20 16:51:00

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

leeyeafu 发表于 2003-10-20 19:34:00

看来楼主也已经努力过了，我将我写的代码帖出来。
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
页: 1 [2] 3
查看完整版本: 怎样用VB实现…………