[原创]仿Stretch命令的几何变形
本帖最后由 作者 于 2008-6-21 13:35:56 编辑在图示中有一四边形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
获取数据的源程序如下。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
以下再做各线段相交点判断程序设计。 感谢楼主提供，谢谢，正用的着
页:
[1]