[教学]：用VBA实现ACAD的lengthen命令

XDSoft

下面的代码实现ACAD的lengthen命令的DY选项。

2. 
   
3. [FONT=courier new]
   
4. 
   
5. Public Sub lengthenExample()
   
6.     Dim oLine As AcadLine
   
7.     Dim angle1 As Double
   
8.     Dim dist1 As Double, dist2 As Double, distStPntPickPnt As Double, halfLenOfLine As Double
   
9.     Dim pickedPnt2 As Variant, returnPnt As Variant
   
10.     Dim basePnt(0 To 2) As Double
    
11.     Dim lineObj As AcadLine
    
12.     Dim intPoints As Variant
    
13.     Dim myRay As AcadRay
    
14.    
    
15.     ThisDrawing.Utility.GetEntity oLine, pickedPnt2, "select object to lengthen"
    
16.      
    
17.     ' distance between the startpoint and
    
18.     ' the picked point
    
19.     dist1 = Abs((oLine.StartPoint(0) - pickedPnt2(0)) * (oLine.StartPoint(0) - pickedPnt2(0)))
    
20.     dist2 = Abs((oLine.StartPoint(1) - pickedPnt2(1)) * (oLine.StartPoint(1) - pickedPnt2(1)))
    
21.     distStPntPickPnt = Sqr(dist1 + dist2)
    
22.    
    
23.    ' Debug.Print "Distance between stPnt and pickedPnt " & dist3 ' for testing
    
24.    
    
25.     ' Use to determine which point should be modified
    
26.     halfLenOfLine = oLine.Length / 2
    
27.    
    
28.     ' this is 90 degrees
    
29.     angle1 = oLine.Angle - 1.57
    
30.    
    
31.     ' basePnt needs to be either the StartPoint or EndPoint
    
32.     ' of the selected line
    
33.      If distStPntPickPnt < halfLenOfLine Then
    
34.         basePnt(0) = oLine.StartPoint(0)
    
35.         basePnt(1) = oLine.StartPoint(1)
    
36.         basePnt(2) = oLine.StartPoint(2)
    
37. 
    
38. 
    
39.      Else
    
40.         basePnt(0) = oLine.EndPoint(0)
    
41.         basePnt(1) = oLine.EndPoint(1)
    
42.         basePnt(2) = oLine.EndPoint(2)
    
43.      End If
    
44.    
    
45.     returnPnt = ThisDrawing.Utility.GetPoint(basePnt, "Enter a point: ")
    
46.    
    
47.     Dim polarPnt As Variant
    
48.     Dim distance As Double
    
49.    
    
50.     ' the distance value is not important
    
51.     ' this line is going to be erased, it is just
    
52.     ' need for the IntersectWith function below
    
53.     distance = 5
    
54.     polarPnt = ThisDrawing.Utility.PolarPoint(returnPnt, angle1, distance)
    
55. 
    
56. 
    
57.     ' Create a ray from the base point to the polar point
    
58.      Set myRay = ThisDrawing.ModelSpace.AddRay(returnPnt, polarPnt)
    
59.    
    
60.     ' Find the intersection points
    
61.     ' intPoints = oLine.IntersectWith(lineObj, acExtendBoth)
    
62.      intPoints = oLine.IntersectWith(myRay, acExtendBoth)
    
63. 
    
64. 
    
65.     ' Change the StartPoint or EndPoint of the line
    
66.     If distStPntPickPnt < halfLenOfLine Then
    
67.         basePnt(0) = intPoints(0)
    
68.         basePnt(1) = intPoints(1)
    
69.         basePnt(2) = intPoints(2)
    
70.         oLine.StartPoint = basePnt
    
71.      Else
    
72.         basePnt(0) = intPoints(0)
    
73.         basePnt(1) = intPoints(1)
    
74.         basePnt(2) = intPoints(2)
    
75.         oLine.EndPoint = basePnt
    
76.      End If
    
77.         
    
78.      myRay.Delete
    
79.      
    
80.      ThisDrawing.Regen acActiveViewport
    
81. 
    
82. 
    
83. End Sub
    
84. 
    
85. 
    
86. [/FONT]

<br /> [FONT=courier new]<br /> <br /> Public Sub lengthenExample()<br />     Dim oLine As AcadLine<br />     Dim angle1 As Double<br />     Dim dist1 As Double, dist2 As Double, distStPntPickPnt As Double, halfLenOfLine As Double<br />     Dim pickedPnt2 As Variant, returnPnt As Variant<br />     Dim basePnt(0 To 2) As Double<br />     Dim lineObj As AcadLine<br />     Dim intPoints As Variant<br />     Dim myRay As AcadRay<br />     <br />     ThisDrawing.Utility.GetEntity oLine, pickedPnt2, "select object to lengthen"<br />      <br />     ' distance between the startpoint and<br />     ' the picked point<br />     dist1 = Abs((oLine.StartPoint(0) - pickedPnt2(0)) * (oLine.StartPoint(0) - pickedPnt2(0)))<br />     dist2 = Abs((oLine.StartPoint(1) - pickedPnt2(1)) * (oLine.StartPoint(1) - pickedPnt2(1)))<br />     distStPntPickPnt = Sqr(dist1 + dist2)<br />     <br />    ' Debug.Print "Distance between stPnt and pickedPnt " & dist3 ' for testing<br />     <br />     ' Use to determine which point should be modified<br />     halfLenOfLine = oLine.Length / 2<br />     <br />     ' this is 90 degrees<br />     angle1 = oLine.Angle - 1.57<br />     <br />     ' basePnt needs to be either the StartPoint or EndPoint<br />     ' of the selected line<br />      If distStPntPickPnt < halfLenOfLine Then<br />         basePnt(0) = oLine.StartPoint(0)<br />         basePnt(1) = oLine.StartPoint(1)<br />         basePnt(2) = oLine.StartPoint(2)<br /> <br /> <br />      Else<br />         basePnt(0) = oLine.EndPoint(0)<br />         basePnt(1) = oLine.EndPoint(1)<br />         basePnt(2) = oLine.EndPoint(2)<br />      End If<br />     <br />     returnPnt = ThisDrawing.Utility.GetPoint(basePnt, "Enter a point: ")<br />     <br />     Dim polarPnt As Variant<br />     Dim distance As Double<br />     <br />     ' the distance value is not important<br />     ' this line is going to be erased, it is just<br />     ' need for the IntersectWith function below<br />     distance = 5<br />     polarPnt = ThisDrawing.Utility.PolarPoint(returnPnt, angle1, distance)<br /> <br /> <br />     ' Create a ray from the base point to the polar point<br />      Set myRay = ThisDrawing.ModelSpace.AddRay(returnPnt, polarPnt)<br />     <br />     ' Find the intersection points<br />     ' intPoints = oLine.IntersectWith(lineObj, acExtendBoth)<br />      intPoints = oLine.IntersectWith(myRay, acExtendBoth)<br /> <br /> <br />     ' Change the StartPoint or EndPoint of the line<br />     If distStPntPickPnt < halfLenOfLine Then<br />         basePnt(0) = intPoints(0)<br />         basePnt(1) = intPoints(1)<br />         basePnt(2) = intPoints(2)<br />         oLine.StartPoint = basePnt<br />      Else<br />         basePnt(0) = intPoints(0)<br />         basePnt(1) = intPoints(1)<br />         basePnt(2) = intPoints(2)<br />         oLine.EndPoint = basePnt<br />      End If<br />         <br />      myRay.Delete<br />      <br />      ThisDrawing.Regen acActiveViewport<br /> <br /> <br /> End Sub<br /> <br /> <br /> [/FONT]