Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  AutoCAD VBA
  Volumenkörper in Block einfügen

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
  
Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte
Autor Thema:  Volumenkörper in Block einfügen (124 mal gelesen)
sarotti
Mitglied
Bauingenieur


Sehen Sie sich das Profil von sarotti an!   Senden Sie eine Private Message an sarotti  Schreiben Sie einen Gästebucheintrag für sarotti

Beiträge: 74
Registriert: 14.07.2005

AutoCad 2022 64Bit
Windows 10-64Bit mit 32 GByte

erstellt am: 10. Nov. 2021 10:08    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo liebe Leute im Forum,

Ich steh auf dem Schlauch! Aus einem vorhanden Block lese ich die Attribute aus. Durch Auswahl soll der Nutzer einen Volumenkörper in der Zeichnung auswählen.
Dieser Volumenkörper soll in einen Block eingefügt werden, und dem neuen Block werden dann die Attribute aus dem Ursprungsblock hinzugefügt.
Ich bekomm den Volumenkörper nicht in den Block eingefügt, was mach ich falsch?

    Dim VKoeper As AcadObject

    ThisDrawing.Utility.prompt Chr(13)
    ThisDrawing.Utility.GetEntity GewObjekt, PickedPoint, "Volumenkörper auswählen:" & prompt
   
    'Überprüfen ob ein gültiges Objekt ausgewählt wurde
    If GewObjekt.ObjectName <> "AcDb3dSolid" Then
      'Fehlermeldung
      MsgBox "Kein Volumenelement ausgewählt!", vbCritical, "Fehlermeldung"
      Exit Sub
    Else
      '************************
      'Block erstellen mit Name
      Set blockObj = ThisDrawing.Blocks.Add(BlockEinfügepkt, Blockname)

      '***********************
      'Volumenelement einfügen

      'Hier ist das Problem, wie füge ich ein Volumenkörper in einen Block ein?
        Set VKoeper = blockObj.Add??????(GewObjekt)
       
       
      'Block in Zeichnung einfügen
        BlockEinfügepkt(0) = 0
        BlockEinfügepkt(1) = 0
        BlockEinfügepkt(2) = 0
        Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(BlockEinfügepkt, Blockname, 1, 1, 1, 0)
    End If


Danke für die Hilfe im voraus.

Sarotti

------------------
AutoCad 2016 64Bit
Windows 8-64Bit mit 8 GByte
Windows 7-64Bit mit 8 GByte

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

rexxitall
Mitglied
Dipl. -Ing. Bau


Sehen Sie sich das Profil von rexxitall an!   Senden Sie eine Private Message an rexxitall  Schreiben Sie einen Gästebucheintrag für rexxitall

Beiträge: 252
Registriert: 07.06.2013

Various: systems, Operating systems, cad systems, cad versions, programming languages.

erstellt am: 17. Dez. 2021 01:32    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für sarotti 10 Unities + Antwort hilfreich

Ein Volumenkörper ist ein Entity. Blöcke bestehen aus Entitys. Die Frage ist wie kopiere ich ein Entity in einen BLOCK


       
Sub TEST_COPY_ENTITYS_TO_BLOCK()
    'test routine keine recursaion etc.
    Dim entity As AcadEntity
    Dim pfentity As AcadEntity
    Dim S As String
    Dim SLOPE As New CMD
    Dim block As AcadBlock
    Dim blockref As AcadBlockReference

    Dim ENT As AcadEntity
    Dim IDPAIRS
    Dim IDPAIR As AcadIdPair
   
    Dim E() As AcadEntity
    ReDim E(0)
    Dim MS As AcadBlock
    Dim M() As Double
    Dim i() As Double
    On Error Resume Next

   
    For Each entity In ThisDrawing.PickfirstSelectionSet
        If entity.objectname <> "AcDbBlockReference" Then
            Set E(0) = entity 'its more save and easy to copy them one by one
            'copy entitys to the modelspace
            Call ThisDrawing.CopyObjects(E, block, IDPAIRS)
            'map the IDPAIRS variant to the type structure
            Set IDPAIR = IDPAIRS(0)
            'Get the new entity by id of the copy
            '(in key is the id of the original)
            Set ENT = ThisDrawing.ObjectIdToObject(IDPAIR.VALUE)
            'apply the current transfomation to the copy
           
        End If
    Next
'Wichtig, sonst sieht man nix !
    ThisDrawing.REGEN acActiveViewport
    APPLICATION.UPDATE

End Sub

Die Sache hat wie so vieles eine "kleinen" Haken - Das oben funktioniert nur für Blöcke die nicht transformiert wurden. Eigentlich müsste man auch sämtliche Verdrehungen, Verschiebungen etc mitberücksichtigen. Was insbesondere bei geschachtelten Blöcken viel Freude bereitet. Habe ich hinter mir, stecken 6 Wochen Arbeit drin, funktioniert. Man benötigt einige .NET APIs um an die Transformationsmatritzen der Blöcke zu gelangen, sowie deren Inversen. Vektorrechnung sollte man Prüfungsreif können. Ferner wissen was eine Rekursion ist und wie man diese programmiert. Bei geschachtelten Blöcken darf man munter während der Rekursion Transformationsmatritzen multiplizieren. Zum Schluss wird dann die Kopie mit der finalen Transformationsmatrix behandelt und das Element ist dann zwar nun im anderen Block an der Zeichnung hat sich optisch dabei nichts geändert.

Für den Zweidimensionalen (flachen) Fall langen Blockeinfügepunkt und Blockrotation. Das ganze für den dreidimensionalen Fall auszuwalzen erspare ich mir hier. Motto: Mir hat damals auch keine Sau geholfen *lacht* Nein, es sprengt von der Codezeilenzahl, der Komplexität, der Mathematik etc. jeglichen Forenrahmen.

Übrigens die IDPAIS sind bei copyobjects sehr hilfreich. Und man findet so gut wie nix darüber...

------------------
Wer es nicht versucht, hat schon verlorn 
Und bei 3 Typos gibts den vierten gratis !
<<< not for sale !

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

sarotti
Mitglied
Bauingenieur


Sehen Sie sich das Profil von sarotti an!   Senden Sie eine Private Message an sarotti  Schreiben Sie einen Gästebucheintrag für sarotti

Beiträge: 74
Registriert: 14.07.2005

AutoCad 2022 64Bit
Windows 10-64Bit mit 32 GByte

erstellt am: 07. Jan. 2022 12:40    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo rexxitall,

vielen Dank für deine ausführliche Antwort. Das ist dann doch etwas viel Aufwand um den Anwender die Auswahl zu erleichtern. Ich gehör damit zu den Verlierern :-)

Ich hab das Problem in der Zwischenzeit umgangen/abgekürzt in dem der Anwender erst mit AutoCAD-Befehlen einen Block erstellen muss und anschließend werden die Attribute von einem Block auf den anderen übertragen.

Gruß

Sarotti

------------------
AutoCad 2022 64Bit
Windows 10-64Bit mit 32 GByte

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

rexxitall
Mitglied
Dipl. -Ing. Bau


Sehen Sie sich das Profil von rexxitall an!   Senden Sie eine Private Message an rexxitall  Schreiben Sie einen Gästebucheintrag für rexxitall

Beiträge: 252
Registriert: 07.06.2013

Various: systems, Operating systems, cad systems, cad versions, programming languages.

erstellt am: 13. Jan. 2022 16:10    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für sarotti 10 Unities + Antwort hilfreich

Es ist nicht blöde wenn es funktioniert 
Deutlich schneller dürfte es noch dazu sein 
L.G. Thomas

------------------
Wer es nicht versucht, hat schon verlorn 
Und bei 3 Typos gibts den vierten gratis !
<<< not for sale !

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

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2022 CAD.de | Impressum | Datenschutz