社区 › VB › 分解非均匀缩放块

chobo 发表于 2007-2-26 20:07:05

分解非均匀缩放块

我想使用VBA执行分解非均匀缩放块
在这种情况下，只有一种方法可以使用SendCommand吗
请给我一些建议
'Bellow code is written by Randall Rath---------------------
Public Function ExplodeEX(oBlkRef As AcadBlockReference, _
    bKeep As Boolean) As Variant
    Dim objEnt As AcadEntity
    Dim objMT As AcadMText
    Dim objBlk As AcadBlock
    Dim objDoc As AcadDocument
    Dim objArray() As AcadEntity
    Dim objSpace As AcadBlock
    Dim intCnt As Integer
    Dim varTemp As Variant
    Dim varPnt As Variant
    Dim dblScale As Double
    Dim dblRot As Double
    Dim dblMatrix(3, 3) As Double
    On Error GoTo Err_Control
    'What document is the reference in?
    Set objDoc = oBlkRef.Document
    'Model space or layout?
    Set objSpace = objDoc.ObjectIdToObject(oBlkRef.OwnerID)
    Set objBlk = objDoc.Blocks(oBlkRef.Name)
    varPnt = oBlkRef.InsertionPoint
    dblScale = oBlkRef.XScaleFactor
    dblRot = oBlkRef.Rotation
    'Set the matrix for new objects transform
    '*Note:
    'This matrix uses only the X scale factor of the
    'Block reference, many entities can not be scaled
    'Non-uniformly!
    dblMatrix(0, 0) = dblScale
    dblMatrix(0, 1) = 0
    dblMatrix(0, 2) = 0
    dblMatrix(0, 3) = varPnt(0)
    dblMatrix(1, 0) = 0
    dblMatrix(1, 1) = dblScale
    dblMatrix(1, 2) = 0
    dblMatrix(1, 3) = varPnt(1)
    dblMatrix(2, 0) = 0
    dblMatrix(2, 1) = 0
    dblMatrix(2, 2) = dblScale
    dblMatrix(2, 3) = varPnt(2)
    dblMatrix(3, 0) = 0
    dblMatrix(3, 1) = 0
    dblMatrix(3, 2) = 0
    dblMatrix(3, 3) = 1
    'Get all of the entities in the block
    ReDim objArray(objBlk.Count - 1)
    For Each objEnt In objBlk
      Set objArray(intCnt) = objEnt
      intCnt = intCnt + 1
    Next objEnt
    'Place them into the correct space
    varTemp = objDoc.CopyObjects(objArray, objSpace)
    'Transform & rotate
    For intCnt = LBound(varTemp) To UBound(varTemp)
      Set objEnt = varTemp(intCnt)
      objEnt.TransformBy dblMatrix
      objEnt.Rotate varPnt, dblRot
    Next intCnt
    'Keep the block reference?
    If Not bKeep Then
      oBlkRef.Delete
    End If
    'Return all of the new entities
    ExplodeEX = varTemp
    'Release memory
    Set objDoc = Nothing
    Set objBlk = Nothing
    Set objSpace = Nothing
    Exit_Here:
    Exit Function
    Err_Control:
    MsgBox Err.Description
    Resume Exit_Here
End Function

Bryco 发表于 2007-2-27 00:36:24

有趣的问题
I&#039；我说sendcommand这个看起来不错
您可以检查块中的ENT类型，并为非&#039；t太难了（直线、柱脚线、圆），但将椭圆更改为样条曲线是我力所不及的。

chobo 发表于 2007-2-27 01:23:26

对于非均匀缩放的块，Autocad在EXPLODE命令中执行了一些奇怪的操作，这不是&#039；t暴露在API中
Bryco&#039；尽管这是一个丑陋的建议，但这几乎是唯一的办法。没有冒犯的意思布莱斯

chobo 发表于 2007-2-28 05:50:34

it#039；太遗憾了。无论如何，谢谢布莱科，格伦。。

查看完整版本: 分解非均匀缩放块