[求助]关于给多位线附加属性和读取属性

江南驿 · 发表于 2007-6-7 10:34:00

各位高手：
小弟想用VBA代码实现如下过程：
有3条多位线pline1,pline2,pline3代表3根电缆
给其附加属性：pline1 名称：电力电缆；截面：200；型号：XY
pline2 名称：信号电缆；截面：100；型号：XZ
pline3 名称：通信电缆；截面：500；型号：YZ
然后有一根line的直线，判断如果line与以上的三条多位线有交点，则画出以交点为圆心半径为电缆截面的圆。
PS：属性中的名称、截面和型号都是从TextBox控件中输入的。
十分感谢！！！

zhuxuhong · 发表于 2007-6-8 09:14:00

1)添加属性可通过 pline1.SetXData(XDataType, XData)来实现
2)求交点
首先,你可通过line直线做为选择集的选择方式,组成与line相交的电缆的选择集
其次,遍历选择集.用Line.IntersectWith(IntersectObject, ExtendOption) 来分别求取每个交点,并用GetXData来读取每条电缆相应的属性信息,并在指定位置画出截面图
具体的可以参照帮助文件

江南驿 · 发表于 2007-6-8 11:51:00

十分感谢zhuxuhong兄的指点
另请问一下附加和获取XDATA是不是这样(以pline1为例)
附加属性
Dim pline1 As AcadLWPolyline
Dim DataType(0 To 3) As Integer
Dim Data(0 To 3) As Variant
TextBox1.text = "电力电缆"
TextBox2.text = "200"
TextBox3.text = "XY"
Set pline1 = ThisDrawing.ModelSpace.AddLightWeightPolyline(arr)
DataType(0) = 1001: Data(0) = TextBox1.text
DataType(1) = 1040: Data(1) = TextBox2.Value
DataType(2) = 1000: Data(2) = TextBox3.text
pline1.SetXData DataType, Data
获取属性
(以下代码：遍历图层“电缆”中所有多位线，如果它与pt1、pt2所围成的矩形有交点，则获取它的截面属性。)
Dim plln As AcadLWPolyline
Dim asss As AcadSelectionSet
Dim ftype1(0) As Integer, fdata1(0) As Variant
Set asss = ThisDrawing.SelectionSets.Add("asss")
If Err Then Set asss = ThisDrawing.SelectionSets.Add("asss")
asss.Clear
ftype1(0) = 8: fdata1(0) = "电缆"
asss.Select acSelectionSetCrossing, pt1, fpt2, ftype1, fdata1
For Each plln In asss
With plln
plln.GetXData "", DataType(1), Data(1)
Dim cc1 As AcadCircle
Set cc1 = ThisDrawing.ModelSpace.AddCircle(point, Data(1))
End With
Next plln
asss.Delete
小弟刚入手VBA，不知道以上代码有什么问题，望各位高手多多指教。感谢！