yiyaozjk 发表于 2014-4-27 17:38:23

我对VB熟悉,但对AUTOCAD VBA还是一知半解。。。求图内查找物料程序

我在图内画了若干个房间,房间用双层矩形表示,

            每一个矩形内写一个文字(物料名称)    矩形代表一种物料大类
            每一个圆形内写一个文字(物料名称)    圆形代表另一种物料大类
            每一个自画形状写一个文字(物料名称)自画形状代表另一种物料大类

想写一个查找程序,这个图内查找物料摆放在哪里。。。

我写了一段初始窗口的。。求助高手帮忙解答。。。

1、如何获取每个形状内的文字。。。
2、如何获取每种不同的形状,并且包括有自画的形状
3、AUTOCAD VBA中是如何查找的,这几个问题解决了,我估计就可以自已解决的问题了。。。 谢谢!

poople 发表于 2014-4-27 22:21:42

你就不能将那些圆、方框什么的做成属性块啊,如果是那样的话遍历起来岂不是容易多了。

yiyaozjk 发表于 2014-4-28 20:43:00

可以呀,定义成块后,只要能找到就可以。。。
楼上的高手能否出手?给一点代码

poople 发表于 2014-4-28 22:45:27

yiyaozjk 发表于 2014-4-28 20:43 static/image/common/back.gif
可以呀,定义成块后,只要能找到就可以。。。
楼上的高手能否出手?给一点代码

我算不上是高手,也是初学一二,最近明经论坛的大神似乎都不在家。
下面是我写的一个供你参考,并附上你的图纸:
'我在你的图上创建了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




elepeipei 发表于 2017-10-16 13:46:28

谢谢楼主分享,学习了
页: [1]
查看完整版本: 我对VB熟悉,但对AUTOCAD VBA还是一知半解。。。求图内查找物料程序