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

兰州人 · 发表于 2008-6-21 13:23:00

kdsd2m2wd55.jpg

在图示中有一四边形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
获取数据的源程序如下。

copy


  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