wgwgoto 发表于 2003-10-23 16:39:00

急救，VBA中,如何把一个闭合图形,向四周缩放

急救，VBA中,如何把一个闭合图形,向四周缩放，比如说，圆中沿心，矩形沿中心，不规则的闭合图形也是沿中心缩放。

谢谢！

今晚打老虎 发表于 2003-10-23 16:43:00

用OFFSET试试～～～

mccad 发表于 2003-10-23 19:07:00

把对象变成面域后，找质心，然后删除面域，然后再把对象从质心来缩放。

wjfling 发表于 2003-10-28 18:58:00

能给一段代码吗？

mccad 发表于 2003-10-28 19:56:00

Sub ScaleEntFromCentro()
    On Error Resume Next
    Dim Ent As AcadEntity
    Dim Pnt As Variant
    ThisDrawing.Utility.GetEntity Ent, Pnt, "选择对象："
    Dim Ents(0) As AcadEntity
    Set Ents(0) = Ent
    Dim Regs As Variant
    Dim Reg As AcadRegion
    Regs = ThisDrawing.ModelSpace.AddRegion(Ents)
    If Err Then
      Err.Clear
      ThisDrawing.Utility.Prompt "选中的对象不能找到合适的中心，程序不能继续进行。"
      Exit Sub
    End If
    If IsArray(Regs) Then
      Set Reg = Regs(0)
      Dim Org As Variant
      Org = Reg.Centroid
      Reg.Delete
      ThisDrawing.SendCommand "scale" & vbCr & axEnt2lspEnt(Ent) & vbCr & vbCr & axPoint2lspPoint(Org) & vbCr
    Else
      ThisDrawing.Utility.Prompt "没有选中闭合的对象，程序不能继续进行。"
    End If
End Sub

Public Function axEnt2lspEnt(entObj As AcadEntity) As String
    Dim entHandle As String
    entHandle = entObj.Handle
    axEnt2lspEnt = "(handent " & Chr(34) & entHandle & Chr(34) & ")"
End Function

Public Function axPoint2lspPoint(Pnt As Variant) As String
    axPoint2lspPoint = Pnt(0) & "," & Pnt(1)
End Function
页: [1]
查看完整版本: 急救，VBA中,如何把一个闭合图形,向四周缩放