[求助]：向斑竹求助:绘制直线如何绕开块

jinfu2908

大哥，小弟我遇到了一些难题，这关系到小弟的学业。
问题是这样的：我要编一个绘制液压原理图的程序，是二维的，我的任务要求是实现原理图中各个液压阀件的自动连线。关键问题是连线时所要连的线要自动绕开阀件（插入的块）要求用VBA编，希望大哥能帮小弟解决这个难题，能给小弟一个自动连线并绕开障碍区（阀件）的源程序，小弟将不胜感激！！！！！！小弟在此先谢谢大哥了！！！谢谢！
我的邮箱是:jinfu2908@sohu.com

efan2000

下面的代码仅是一个例子，针对特定的情况，真正实用的还需要做进一步的处理，要考虑各种情况。

2. 
   
3.   [FONT=courier new]
   
4. Sub test()
   
5.     Dim EntObj As AcadEntity
   
6.     Set EntObj = ThisDrawing.ModelSpace(0)
   
7.     ' 创建实体的包含外框
   
8.     Dim minPt As Variant
   
9.     Dim maxPt As Variant
   
10.     EntObj.GetBoundingBox minPt, maxPt
    
11.     Dim sPts(0 To 7) As Double
    
12.     sPts(0) = minPt(0): sPts(1) = minPt(1)
    
13.     sPts(2) = maxPt(0): sPts(3) = minPt(1)
    
14.     sPts(4) = maxPt(0): sPts(5) = maxPt(1)
    
15.     sPts(6) = minPt(0): sPts(7) = maxPt(1)
    
16.     Dim LWPlineObj As AcadLWPolyline
    
17.     Set LWPlineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(sPts)
    
18.     LWPlineObj.Closed = True
    
19.     Set EntObj = LWPlineObj
    
20.     EntObj.Visible = False
    
21.    
    
22.     ' 创建多义线
    
23.     Dim dPts(0 To 3) As Double
    
24.     Dim Pt As Variant
    
25.     Pt = ThisDrawing.Utility.GetPoint(, "指定第一点: ")
    
26.     dPts(0) = Pt(0): dPts(1) = Pt(1)
    
27.     Pt = ThisDrawing.Utility.GetPoint(Pt, "指定下一点: ")
    
28.     dPts(2) = Pt(0): dPts(3) = Pt(1)
    
29.     Set LWPlineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(dPts)
    
30.     ' 求交
    
31.     Dim Pts As Variant
    
32.     Pts = LWPlineObj.IntersectWith(EntObj, acExtendNone)
    
33.     ' 增加顶点
    
34.     Dim v(0 To 1) As Double
    
35.     v(0) = Pts(3): v(1) = Pts(4)
    
36.     LWPlineObj.AddVertex 1, v
    
37.     v(0) = sPts(6): v(1) = sPts(7)
    
38.     LWPlineObj.AddVertex 2, v
    
39.     v(0) = sPts(0): v(1) = sPts(1)
    
40.     LWPlineObj.AddVertex 3, v
    
41.     v(0) = Pts(0): v(1) = Pts(1)
    
42.     LWPlineObj.AddVertex 4, v
    
43.     EntObj.Delete
    
44. End Sub
    
45.   [/FONT]
    

<br />   [FONT=courier new]<br /> Sub test()<br />     Dim EntObj As AcadEntity<br />     Set EntObj = ThisDrawing.ModelSpace(0)<br />     ' 创建实体的包含外框<br />     Dim minPt As Variant<br />     Dim maxPt As Variant<br />     EntObj.GetBoundingBox minPt, maxPt<br />     Dim sPts(0 To 7) As Double<br />     sPts(0) = minPt(0): sPts(1) = minPt(1)<br />     sPts(2) = maxPt(0): sPts(3) = minPt(1)<br />     sPts(4) = maxPt(0): sPts(5) = maxPt(1)<br />     sPts(6) = minPt(0): sPts(7) = maxPt(1)<br />     Dim LWPlineObj As AcadLWPolyline<br />     Set LWPlineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(sPts)<br />     LWPlineObj.Closed = True<br />     Set EntObj = LWPlineObj<br />     EntObj.Visible = False<br />     <br />     ' 创建多义线<br />     Dim dPts(0 To 3) As Double<br />     Dim Pt As Variant<br />     Pt = ThisDrawing.Utility.GetPoint(, "指定第一点: ")<br />     dPts(0) = Pt(0): dPts(1) = Pt(1)<br />     Pt = ThisDrawing.Utility.GetPoint(Pt, "指定下一点: ")<br />     dPts(2) = Pt(0): dPts(3) = Pt(1)<br />     Set LWPlineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(dPts)<br />     ' 求交<br />     Dim Pts As Variant<br />     Pts = LWPlineObj.IntersectWith(EntObj, acExtendNone)<br />     ' 增加顶点<br />     Dim v(0 To 1) As Double<br />     v(0) = Pts(3): v(1) = Pts(4)<br />     LWPlineObj.AddVertex 1, v<br />     v(0) = sPts(6): v(1) = sPts(7)<br />     LWPlineObj.AddVertex 2, v<br />     v(0) = sPts(0): v(1) = sPts(1)<br />     LWPlineObj.AddVertex 3, v<br />     v(0) = Pts(0): v(1) = Pts(1)<br />     LWPlineObj.AddVertex 4, v<br />     EntObj.Delete<br /> End Sub<br />   [/FONT]<br />

jinfu2908

十分感谢，请问要实现它是不是很复杂？

qren25

主要是判断块的实际包含范围，算法同意上楼的！