我对VB熟悉，但对AUTOCAD VBA还是一知半解。。。求图内查找物料程序
我在图内画了若干个房间，房间用双层矩形表示，每一个矩形内写一个文字（物料名称） 矩形代表一种物料大类
每一个圆形内写一个文字（物料名称） 圆形代表另一种物料大类
每一个自画形状写一个文字（物料名称）自画形状代表另一种物料大类
想写一个查找程序，这个图内查找物料摆放在哪里。。。
我写了一段初始窗口的。。求助高手帮忙解答。。。
1、如何获取每个形状内的文字。。。
2、如何获取每种不同的形状，并且包括有自画的形状
3、 VBA中是如何查找的，这几个问题解决了，我估计就可以自已解决的问题了。。。 谢谢！
**** Hidden Message ***** 你就不能将那些圆、方框什么的做成属性块啊，如果是那样的话遍历起来岂不是容易多了。 可以呀，定义成块后，只要能找到就可以。。。
楼上的高手能否出手？给一点代码
我算不上是高手，也是初学一二，最近乐筑天下论坛的大神似乎都不在家。
下面是我写的一个供你参考，并附上你的图纸：
'我在你的图上创建了3种属性快，名称分别为：
'“福瓶”——方框，“花瓶”——圆，“青花缸”——圆锥
'现在以“福瓶”为例子
Private Sub Demo()
'先创建选择集，为了可以多次创建选择集应该删掉原来存在的选择集
Dim i As Integer
Dim SSet As AcadSelectionSet
For i = 0 To ThisDrawing.SelectionSets.Count - 1
If StrComp("X_SSET", ThisDrawing.SelectionSets.Item(i).Name, vbTextCompare) = 0 Then
ThisDrawing.SelectionSets.Item(i).Delete
Exit For
End If
Next
Set SSet = ThisDrawing.SelectionSets.Add("X_SSET")
'定义过滤表，做到精确选取
Dim fType(2) As Integer
Dim fDate(2) As Variant
fType(0) = 0: fDate(0) = "INSERT"
fType(1) = 2: fDate(1) = "福瓶"
fType(2) = 66: fDate(2) = 1
'到图纸中选择
SSet.SelectOnScreen fType, fDate
'遍历内容
Dim Ent As AcadBlockReference
Dim AttArry As Variant
For i = 0 To SSet.Count - 1
Set Ent = SSet.Item(i)
AttArry = Ent.GetAttributes
'应为我只定义一个属性，所以AttArry下标为0即可
ThisDrawing.Utility.Prompt vbCrLf & "第 " & i + 1 & " 个属性块的值为：" & AttArry(0).TextString
Next
End Sub
谢谢楼主分享，学习了
页:
[1]