---

Hi Leute,

habe gleich noch eine Frage:
Ich habe einen Block, bestehend aus anderen, skalierten Blöcken. Wenn ich diesen Block nur in X-Richtung mit Faktor 2 skaliere und anschließend auflöse, erhalte ich das korrekte Ergebnis (Faktoren des aufgelösten, "übergeordneten" Blocks wurden auf die enthaltenen Blöcke übertragen)
Leider habe ich noch keine Möglichkeit gefunden, diese Funktionalität mit VBA nachzubilden.
Version wie gehabt AutoCAD 2004 inkl. SPs
Würde mich über Tipps freuen.

tia

Sebastian

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

na dann guck doch mal in der Hilfe: Entwicklerdokumentation- ActivX und VBA-Referez -> Objects -> Blockref Object -> Methods + Propertys

------------------
- Thomas -

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Thomas,

ich hätte nicht gepostet, wenn ich das nicht schon gemacht hätte... Mein Problem ist, daß das Explode von VBA aus sämtliche Skalierfaktoren eliminiert... was in dieser Form für mich unbrauchbar ist...
Versuch mal den von mir beschriebenen Weg nachzuvollziehen, du wirst sehen, was ich meine...

Trotzdem danke

Sebastian

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Sorry, ist  mir noch gar nicht so aufgefallen..
ist zwar lisp (und nur auf die Schnelle)  ,aber

(defun INSERT-EXPLODE( / )
  (if (setq AUSWAHL(ssget "_:S" '((0 . "INSERT"))))
    (progn
      (vla-explode(vlax-ename->vla-object (ssname AUSWAHL 0)))
      (vla-delete(vlax-ename->vla-object (ssname AUSWAHL 0)))
    ) 
  )   
)

liefert bei skalierten Blockrefernzen bei mir einen
"Automatisierungsfehler Ungültige Eingabe" bei unsklierten funzt es

..mhmmm ...
der Weg über Skalierung merken .. Skalieren auf 1 .. exploden und alle zurückgegebenen Elemente wieder skalieren scheint mir auch etwas unpraktikabel...

vielleicht hat ja jemand noch ne Idee

------------------
  - Thomas -

[Diese Nachricht wurde von CADmium am 17. Mai. 2004 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Thomas,

der Weg ist eigentlich gut, ich hab auch ein Makro gefunden, daß das könnte, leider arbeitet es mit einer Transformation und die geht nicht mit Blockreferenzen. Vielleicht hast du noch eine andere Idee?
Wenns hilft poste ich auch gern den Code...

tia

Sebastian

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Sebastian,
wie wäre es wenn du deine Funktion einmal hier ins Forum stellen würdest. Dann könnten wir einmal schaun was nicht funktioniert (und ob es überhaupt funktioniert).

------------------
Roland

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Ich hab mir das jetzt noch einmal angesehen, bei mir funktioniert es fast ohne Probleme, allerdings muß ich dir recht geben das man keine Blöcke explodieren kann bei denen nur ein Faktor geändert wurde. Das muß man dan händisch erledigen, leider.

------------------
Roland

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Roland,

die Routine sieht folgendermaßen aus (stammt aus meinem VB-Programm und ist eigentlich aus diesem Forum "geklaut") und funkt mit "normalen" Elementen einwandfrei (zu finden bei "case else"). Die Formel für die Blockreferenz ist definitiv falsch, konnte aber bisher nichts besseres finden... :-(

Private 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
Dim dblOrigin(2) 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
    dblOrigin(0) = 0#: dblOrigin(1) = 0#: dblOrigin(2) = 0#
    '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) = oBlkRef.XScaleFactor
    dblMatrix(0, 1) = 0
    dblMatrix(0, 2) = 0
    dblMatrix(0, 3) = varPnt(0)
    dblMatrix(1, 0) = 0
    dblMatrix(1, 1) = oBlkRef.YScaleFactor
    dblMatrix(1, 2) = 0
    dblMatrix(1, 3) = varPnt(1)
    dblMatrix(2, 0) = 0
    dblMatrix(2, 1) = 0
    dblMatrix(2, 2) = oBlkRef.ZScaleFactor
    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)
        Select Case objEnt.ObjectName
            Case "AcDbBlockReference"
                'objEnt.TransformBy dblMatrix
                Debug.Print objEnt.XScaleFactor, objEnt.YScaleFactor, objEnt.ZScaleFactor, objEnt.Rotation
                objEnt.XScaleFactor = oBlkRef.XScaleFactor * (objEnt.XScaleFactor * Sin(objEnt.Rotation) + objEnt.YScaleFactor * Cos(objEnt.Rotation))
                objEnt.YScaleFactor = oBlkRef.YScaleFactor * (objEnt.XScaleFactor * Sin(objEnt.Rotation) + objEnt.YScaleFactor * Cos(objEnt.Rotation))
                objEnt.ZScaleFactor = oBlkRef.ZScaleFactor * objEnt.ZScaleFactor
                objEnt.Move dblOrigin, varPnt
                objEnt.Rotate varPnt, oBlkRef.Rotation
            Case "AcDbAttribute"
           
            Case Else
                objEnt.TransformBy dblMatrix
                objEnt.Rotate varPnt, dblRot
        End Select
    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

tia

Sebastian

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP