[VBA]两个问题请教

ntchjie · 发表于 2004-11-10 20:28:00

1、关于块筛选的问题，FilterType设置为0， FilterData用什么字符串？块上有扩展数据，是否与这个有关，我试过了很多，都不成功。
2、附图中选择了首尾两个直线，用算法如何实现读入图中红色的线段的长度。
如果一根与一跟相连，可以读入，但一根接两根，特别是多个一接两，就比较复杂了，请斑竹指教指教算法。

ntchjie · 发表于 2004-11-10 20:29:00

不知道为什么，图没有贴上去。

dynxwolxtw2.JPG

雪山飞狐_lzh · 发表于 2004-11-10 21:36:00

1、命令行键入"(entget(car(entsel)))",选择要过滤的实体看看DXF组码2、用回溯法，从起点出发，先找一个路径，如果终点正好对应成功，如果不是，就会退一个点再找，直到找到为止

ntchjie · 发表于 2004-11-11 10:06:00

获取到的数据如下：
((-1 . ) (0 . "INSERT") (330 . ) (5 . "158DEB") (100 . "AcDbEntity") (67 . 0) (410 . "Model")
(8 . "A_A") (6 . "ByBlock") (100 . "AcDbBlockReference") (2 . "cj_jcj") (10
97782.1 21024.2 0.0) (41 . 1.0) (42 . 1.0) (43 . 1.0) (50 . 0.0) (70 . 0) (71 .
0) (44 . 0.0) (45 . 0.0) (210 0.0 0.0 1.0))
我想应该是AcDbBlockReference，但调试没有成功。
奇怪的是，居然是INSERT，真的迷惑了。

CLARKLEE · 发表于 2005-1-17 14:25:00

请问板竹DXF组码是什么东东，我不太理解，是过几次均不成功
能不能详细解答一下

雪山飞狐_lzh · 发表于 2005-1-17 22:07:00

DXF组码是CAD实体在Dwg文件中的实际组成形式（个人观点），帮助里有关于DXF组码的详细说明

zzp-2000 · 发表于 2005-1-18 08:45:00

带属性的块组码是2，名称是块的名称，示例：
这是我在图形中快速查找“GUANKOUHAO”和“GUANKOUBIAO”的属性块，并在找到后删除的一段模块。
Dim ssets As AcadSelectionSet
Dim EntObj As AcadObject
Dim gpCode(3) As Integer
Dim dataValue(3) As Variant
Dim groupCode As Variant, dataCode As Variant
Dim N As Integer
Dim varAtt As Variant
On Error Resume Next
Set ssets = DOCobj.SelectionSets("ZZPset")
If Err Then
   Err.Clear
   Set ssets = DOCobj.SelectionSets.Add("ZZPset")
End If
ssets.Clear
gpCode(0) = -4: gpCode(1) = 2: gpCode(2) = 2: gpCode(3) = -4
dataValue(0) = ""
groupCode = gpCode
dataCode = dataValue
ssets.Select acSelectionSetAll, , , groupCode, dataCode
For N = 0 To ssets.Count - 1
   Set EntObj = ssets.Item(N)
   varAtt = EntObj.GetAttributes
   If varAtt(0).TextString = "管口号" Then
   ElseIf varAtt(0).TextString = GKHname Then
   EntObj.Delete
   End If
Next N
Set EntObj = Nothing
ssets.Delete
End Sub

laoliu09 · 发表于 2005-1-18 19:47:00

如果块属性不止一个的话，这样就不行了，应该改一下
for i=0 to Ubound(varAtt) step 2
If varAtt(i).TextString = "管口号" Then EntObj.Delete
ElseIf varAtt(i).TextString = GKHname Then EntObj.Delete
End If

[VBA]两个问题请教

发表回复

精选推荐