[原创]仿Stretch命令的几何变形

兰州人

在图示中有一四边形ABCD，如果用Stretch命令，可得AB''C'D
编程要求原线段是AB=10,当AB＝20时，
AD和BC线段不变，四边形变形后几何形状如AB‘C’D
解决方法如下，首先将获取四边形的实体数据
"m1","m2","m3","m4","m5","m6","m7","m8","m9","m10","m11","m12"
"AcDbLine",2129989240,416.61467,431.12093,960.02511,614.21426,0
"AcDbLine",2129989264,960.02511,614.21426,785.28137,810.08154,0
"AcDbLine",2129989272,416.61467,431.12093,320.71871,859.04836,0
"AcDbLine",2129989280,320.71871,859.04836,785.28137,810.08154,0
获取数据的源程序如下。

2.   Dim LineData As AcadLine, ArcData As AcadArc
3.   Close #1
4.   Open "D:\ls.txt" For Output As #1
5.   
6.   Write #1, "m1", "m2", "m3", "m4", "m5", "m6", "m7", "m8", "m9", "m10", "m11", "m12"
7.   
8.   Dim Ent As AcadEntity
9.   
10.   For Each Ent In ThisDrawing.ModelSpace
11.     m1 = Ent.ObjectName
12.     m2 = Ent.ObjectID
13.     Select Case Ent.ObjectName
14.       Case "AcDbLine"
15.         Set LineData = Ent
16.         With LineData
17.           m3 = Round(.StartPoint(0), 5)
18.           m4 = Round(.StartPoint(1), 5)
19.           m5 = Round(.StartPoint(2), 5)
20.           m6 = Round(.EndPoint(0), 5)
21.           m7 = Round(.EndPoint(1), 5)
22.           m8 = Round(.EndPoint(2), 5)
23.          
24.         End With
25.     End Select
26.     Write #1, m1, m2, m3, m4, m6, m7, m8
27.    
28.   Next Ent
29.   Ent.GetBoundingBox
30.   Close #1

  Dim LineData As AcadLine, ArcData As AcadArc   Close #1   Open "D:\ls.txt" For Output As #1      Write #1, "m1", "m2", "m3", "m4", "m5", "m6", "m7", "m8", "m9", "m10", "m11", "m12"      Dim Ent As AcadEntity      For Each Ent In ThisDrawing.ModelSpace     m1 = Ent.ObjectName     m2 = Ent.ObjectID     Select Case Ent.ObjectName       Case "AcDbLine"         Set LineData = Ent         With LineData           m3 = Round(.StartPoint(0), 5)           m4 = Round(.StartPoint(1), 5)           m5 = Round(.StartPoint(2), 5)           m6 = Round(.EndPoint(0), 5)           m7 = Round(.EndPoint(1), 5)           m8 = Round(.EndPoint(2), 5)                   End With     End Select     Write #1, m1, m2, m3, m4, m6, m7, m8       Next Ent   Ent.GetBoundingBox   Close #1

以下再做各线段相交点判断程序设计。

chengzhang

感谢楼主提供，谢谢，正用的着