[VBA程序]：用什么方法把一个图层中的各个图元分离开来

earchen

我在用VBA进行cad的二次开发，我想对一个有特殊意义的图层中的各个图元分别处理，有什么方法把这些图元分离开吗。我是新手

gyl

什么意思？是放到不同图层吗？

赠一见

问题本身有些绕

earchen

我的问题是这样的：我在一个叫“曲线”的图层里绘制了许多曲线，另外有一条直线在0层里，现在我想求出这条直线和那些曲线的交点，并把交点坐标放在一个数组里。由于求交点的函数intersectWith每次只能求两个物体的交点，所以我想用循环语句分别求每条曲线和直线的交点，这样就涉及到了把曲线从图层中读出来的问题。就像做了一个选择集，然后用item属性对选择集里的对象分别进行处理一样。

lijiao

用过滤器的方法构造一个选择集，就可以达到你的目的（用VL比较方便）。

efan2000

使用过滤机制，构造层的选择集。

2. 
   
3.   [FONT=courier new]
   
4. Sub Example_Select()
   
5.    
   
6.     ' 创建选择集
   
7.     Dim ssetObj As AcadSelectionSet
   
8.    
   
9.     On Error Resume Next
   
10.     Set ssetObj = ThisDrawing.SelectionSets("SSET")
    
11.     If Err Then
    
12.         Err.Clear
    
13.         Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")
    
14.     End If
    
15.     ssetObj.Clear
    
16.    
    
17.     '构造过滤机制
    
18.     Dim groupCode(0) As Integer
    
19.     Dim dataCode(0) As Variant
    
20.     groupCode(0) = 8 '层组码
    
21.     dataCode(0) = "曲线" '层名
    
22. 
    
23.     ssetObj.Select acSelectionSetAll, , , groupCode, dataCode
    
24.    
    
25.     '更好的方法是只选中与直线外框相交或者位于其中的对象
    
26.    
    
27.     '获取直线的外框
    
28.     Dim corner1 As Variant
    
29.     Dim corner2 As Variant
    
30.     'Dim lineObj As AcadLine
    
31.     lineObj.GetBoundingBox corner1, corner2 'lineObj为位于0层的直线
    
32.    
    
33.     ssetObj.Select acSelectionSetCrossing, corner1, corner2, groupCode, dataCode
    
34.    
    
35. End Sub
    
36.   [/FONT]
    

<br />   [FONT=courier new]<br /> Sub Example_Select()<br />     <br />     ' 创建选择集<br />     Dim ssetObj As AcadSelectionSet<br />     <br />     On Error Resume Next<br />     Set ssetObj = ThisDrawing.SelectionSets("SSET")<br />     If Err Then<br />         Err.Clear<br />         Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")<br />     End If<br />     ssetObj.Clear<br />     <br />     '构造过滤机制<br />     Dim groupCode(0) As Integer<br />     Dim dataCode(0) As Variant<br />     groupCode(0) = 8 '层组码<br />     dataCode(0) = "曲线" '层名<br /> <br />     ssetObj.Select acSelectionSetAll, , , groupCode, dataCode<br />     <br />     '更好的方法是只选中与直线外框相交或者位于其中的对象<br />     <br />     '获取直线的外框<br />     Dim corner1 As Variant<br />     Dim corner2 As Variant<br />     'Dim lineObj As AcadLine<br />     lineObj.GetBoundingBox corner1, corner2 'lineObj为位于0层的直线<br />     <br />     ssetObj.Select acSelectionSetCrossing, corner1, corner2, groupCode, dataCode<br />     <br /> End Sub<br />   [/FONT]<br />