---

Hallo,
ich versuch einen Block in eine Zeichnung über VBA einzufügen.
Grundsätzlich funktioniert es auch.
Nun definiere ich mir aber ein User-Koordinatensystem, welches nicht nur verschoben ist im Raum, sondern auch noch verdreht. Füge ich jetzt in dieses UCS einen Block ein, so ist der Block zwar an der richtigen Stelle, aber er ist verdreht und zwar so, dass die x-Achse vom Block immernoch parallel zur x-Achse vom WCS liegt, obwohl die x-Achse vom UCS nicht parallel ist.

Versteht einer was ich mein und kann mir vielleicht helfen?

Den Block füge ich mit folgendem Befehl ein:
Set AO_BLOCK = AO_DOC.ModelSpace.InsertBlock(P_POINT1, BLOCK_NAME , 1#, 1#, 1#, 0)

Danke schonmal.

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

---

Die Methoden in VBA verwenden immer WKS-Koordinaten... du mußt deshalb deine der Methode InsertBlock übergebenen Werte (wwen gewünscht) auf das jeweilige UCS umrechnen.

dazu die Methode TranslateCoordinates des Utility-Objectes des Documents verwenden
------------------
      - Thomas -
"Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben."

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

---

okay ich versuchs nochmal etwas genauer

also ich hab 3 Punkte für mein UCS
P1(82500,-1511.158,30261.325)
P2(82598.06,-1526.637,30273.354)
P3(32500,-1449.797,30340.286)

dann hab ich in einem dwg einen Block, ums einfach zumachen ein Rechteck (0,0,0 - 1000,1000,0)

in meinen Code verwende ich sowohl VBA Befehle für das Blockeinfügen, aber auch die AutoCAD command zeile um das Koordinatensystem zu ändern

Teil aus dem Main:

'das Koordinatensystem verändern
                '-------------------------------
                Call COMMAND_UCS_DEFINE_COORDINATES(P_POINT1, P_POINT2, P_POINT3)
                'den Screen in die Zeichnung einfügen
                '------------------------------------
                Set AO_BLOCK = AO_DOC.ModelSpace.InsertBlock(P_POINT1, S_PATH_INPUT_SCREENS & S_NAME & "_3D.dwg", 1#, 1#, 1#, 0#)
                'das Koordinatensystem wieder auf World setzten
                '-----------------------------------------------
                Call COMMAND_UCS_WORLD(ThisDrawing)

die nötigen Funktionen
Function COMMAND_UCS_DEFINE_COORDINATES(P_POINT1 As Variant, P_POINT2 As Variant, P_POINT3 As Variant)
    'Funktion definiert durch 3 Punkte ein UserKoordinatensystem
    ThisDrawing.SendCommand "_ucs" & vbCr
    ThisDrawing.SendCommand "_3" & vbCr
    ThisDrawing.SendCommand P_POINT1(0) & "," & P_POINT1(1) & "," & P_POINT1(2) & vbCr & _
                            P_POINT2(0) & "," & P_POINT2(1) & "," & P_POINT2(2) & vbCr & _
                            P_POINT3(0) & "," & P_POINT3(1) & "," & P_POINT3(2) & vbCr
End Function

Function COMMAND_UCS_WORLD(AO_DOC As AcadDocument)
    'Funktion ruft das Weltkoordinatensystem auf
    AO_DOC.SendCommand "_ucs" & vbCr & vbCr
    AO_DOC.SendCommand Chr(27)
End Function

Der Block wird nun also an der richtigen Stelle eingefügt, aber eben verdreht. Aber schon in der xy-Ebene vom UCS
Das sich das Einfügen vom Block auf das WCS bezieht, versteh ich dann nur bedingt.

Aber gibt es eine einfache Funktion, im den Drehwinkel herauszubekommen?

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

---

Systemvariablen UCSXDIR UCSYDIR ?

------------------
  - Thomas -
"Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben."

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

---

Hallo Emara,

die folgende Funktion wandelt die Koordinaten des Einfügepunktes in WKS-Koordinaten um.
Allerdings nur für 2D. Aber wenn Du die Funktion verstehst ist es kein Problem diese auf 3D umzuwandeln.

Gruß

Sarotti

Function PunktUCS_in_WCS(ByVal PKTx As Double, ByVal PKTy As Double)
    Dim PktUCS(2) As Double
    Dim PktWCS(2) As Double
    Dim pointWCS As Variant
    Dim pointUCS As Variant
   
    PktUCS(0) = PKTx
    PktUCS(1) = PKTy
    PktUCS(2) = 0
    pointWCS = PktUCS
    pointUCS = ThisDrawing.Utility.TranslateCoordinates(pointWCS, acUCS, acWorld, False)
    PktWCS(0) = pointUCS(0)
    PktWCS(1) = pointUCS(1)
   
    PunktUCS_in_WCS = PktWCS
End Function

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