我使用的方法不是搜索整个dwg&将实体与选定点进行比较，而是从选定点开始搜索，以设定的距离创建一个选择集&使用循环，如果没有找到任何东西，则增加面积，直到找到实体。这很有效&到目前为止很快。然而，当发现多个实体时，我必须添加一个测试&如果找到了多个实体，则比较它们以选择最接近的实体
选择实体后，从该实体开始，所有实体都将向下移动，获取z坐标，将插入点重置为所需的高程（z坐标），并创建树对象。 只是不要为她做所有的工作，特雷夫。我相信这是她学校论文的一部分。 我使用下面的代码：
Thsi one 只为一个盒子工作，在 ceratain 条件下
选项 显式
公共子 LandLW_inter（）
Dim myline 作为 AcadLine
Dim mysel 作为 AcadSelectionSet
Dim selset 作为 AcadSelectionSet Dim selset 作为 AcadSelectionSet
Dim mypl 作为 AcadLWPolyline
Dim ptst（0 to 2） 作为 Double
Dim ptend（0 to 2） 作为 Double
Dim FilterType（0 to 0） 作为 Integer
Dim FilterData（0 to 0） 作为 Variant
DimIntPnts 作为 Variant
Dim cnt As Integer
Dimi As Integer
cnt = 0
Set selsets = ThisDrawing.SelectionSets
' for one
block'points that make the house
ptst（0） = 742： ptst（1） = 1029： ptst（2） = 0
ptend（0） = 769： ptend（1） = 1058： ptend（2） =
0'draw the line for effect
Set myline = ThisDrawing.ModelSpace.AddLine（ptst， ptend）
myline.颜色 = acRed
对于每个 mysel 在 selsets
If mysel.名称 = “我的” 然后是
mysel。
如果
下一个 mysel
Set mysel = ThisDrawing.SelectionSets.Add（“mine”）
FilterType（0） = 0： FilterData（0） = “LWPolyline” ' filter on type - lwpolylines
mysel.选择 acSelectionSetCrossing， ptst， ptend， FilterType，
FilterData's select 所有越过我们行边界框
的东西'过滤掉除 lwpolyline Debug 之外的所有内容
。打印“与 ”和 mysel 相交”。Count & “ lwpolylines”
For Each mypl In mysel
cnt = cnt + 1
Debug.Print “ Intersection ： ” & cnt & “ with Contour ” & mypl.海拔
ptst（2） = mypl.海拔高度： ptend（2） = mypl.海拔
'画线效果 - 不是真的需要这个
' 设置我的线= ThisDrawing.ModelSpace.AddLine（ptst，ptend）
'myline。Color = acRed
varIntPnts = myline.IntersectWith（mypl， acExtendNone）
For i = 0 To UBound（varIntPnts）
Debug.Print varIntPnts（i）
Next i
Next mypl
End Sub
Daron ..不要在特雷夫的脑海中种下这样可怕的想法。嘿嘿，
这仅仅是个开始......对他来说至少还有95%......或任何想从事这项工作的人
页:
1
[2]