---

Hallo,

ich komm einfach nicht mit dem UCS-Object klar.
Ich möchte verschiedene Querschnitte mit VBA zeichnen.
Damit ich für jeden Querschnitt mit den gleichen Koordinaten arbeiten
kann möchte ich den Nullpunkt verschieben.
Also:

Wie erstelle ich ein neues UCS, daß 20Einheiten in X und 20 Einheiten in Y vom aktuellen UCS entfernt ist?

Vielen Dank im Vorraus

Jens

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

---

In VBA gibt es nur das WKS, wenn du Schnitte generieren möchtest, dann mußt du schon die Punkte aus dem WKS kennen.

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

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

---

Hallo,

Man kann doch laut Entwicklerhilfe eigene UCS`s erstellen.
Ich schaffe es nur nicht meinen Ursprung zu verschieben.

Jens

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

---

http://ww3.cad.de/foren/ubb/Forum259/HTML/000053.shtml

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

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

---

Hab ich schon gelesen, Danke.
Hast Du vieleicht ein Beispiel wie ich ein neues UCS an den Koordinaten 20,20,0 erstelle?

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

---

Code:

---

    Dim origin(2) As Double, XVector(2) As Double, YVector(2) As Double
   
    origin(0) = 20
    origin(0) = 20
    origin(0) = 0
   
    XVector(0) = 1
    XVector(1) = 0
    XVector(2) = 0

    YVector(0) = 0
    YVector(1) = 1
    YVector(2) = 0
   
    Dim a1 As AcadUCS
    Set a1 = ActiveDocument.UserCoordinateSystems.Add(origin, XVector, YVector, "Welt")
    ActiveDocument.ActiveUCS = a1

---

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

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

---

Hallo,

Ich glaub ich verstehe das mit dem UCS falsch.
Nach meinem Verständnis müsste untenstehender Code
2 Kreise an unterschiedlichen Koordinaten zeichnen.
Ist aber nicht so. Warum wirkt sich das neue UCS nicht auf die
Koordinaten aus?

-------------------------------------------------
Public Sub NewUcs()

' Objecte
Dim aDoc As AcadDocument
Dim aUcs(1) As AcadUCS
Dim aCircle(1) As AcadCircle

' Variablen
Dim pOrigin(2) As Double
Dim pXVector(2) As Double
Dim pYVector(2) As Double
Dim pCircle(2) As Double
   
pOrigin(0) = 0
pOrigin(0) = 0
pOrigin(0) = 0
   
pXVector(0) = 1
pXVector(1) = 0
pXVector(2) = 0

pYVector(0) = 0
pYVector(1) = 1
pYVector(2) = 0

pCircle(0) = 0
pCircle(1) = 0
pCircle(2) = 0

  Set aDoc = ActiveDocument
  Set aUcs(0) = aDoc.UserCoordinateSystems.Add(pOrigin, pXVector, pYVector, "UCS1")
  aDoc.ActiveUCS = aUcs
  Set aCircle(0) = aDoc.ModelSpace.AddCircle(pCircle, 3)

pOrigin(0) = 20
pOrigin(1) = 20
pOrigin(2) = 0

  Set aUcs(1) = ActiveDocument.UserCoordinateSystems.Add(pOrigin, pXVector, pYVector, "UCS2")
  aDoc.ActiveUCS = aUcs(1)
  Set aCircle(1) = aDoc.ModelSpace.AddCircle(pCircle, 3)

ZoomAll

End Sub

---------------------------------------------------------------------

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

---

[list type=A]

Hab ich dir doch schon gesagt, ES GIBT NUR DAS WKS IN VBA

Probier es einmal damit:
[/list]

Code:

---

ThisDrawing.Utility.TranslateCoordinates(PtTemp, acWorld, acUCS, False)

---

oder

Code:

---

ThisDrawing.Utility.TranslateCoordinates(PtTemp, acUCS, acWorld, False)

---

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

[Diese Nachricht wurde von RoSiNiNo am 31. Oktober 2003 editiert.]

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