---

Hallo,
ich bastel gerade an einem Programm und habe Fragen zur Weiterverarbeitung mit BKS
Koordinaten bzw. zum Erstellen von Objekten im neuen BKS
- 3Punkte vorhanden
- 2Punkte werden mit einer Linie verbunden (3D)
- diese Linie soll eigentlich versetzt werden(hat nicht funktioniert, daher hier ein Hilfspunkt)
- aus Startpkt, Endpkt und dem Hilfspunkt wird ein BKS erstellt
- ein nächstes BKS wird auf der Linie vom Zylinderstartpunkt zum Hilfspunkt erzeugt
  (die Linie bildet später die untere Linie der XY Ebene)
  - normalerweise haben wir diese Ansicht mit dem Befehl ddvpoint erzeugt, habe ich aber
    für VBA nicht gefunden)
- in diesem BKS bzw. dieser Ansicht soll ein Kreis gezeichnet werden, der zum Zylinder extrudiert wird.

Nun meine Fragen:
ohne den Befehl translatecoordinates wird das zweite BKS falsch erstellt, da die Weltkoordinaten verwendet werden.
mit dem Befehl translateCoordinates wird der Kreis im Ursprung des WKS gezeichnet und nicht in meinem BKS????
Vielleicht kann mir jemand einen Tip geben????
Vielen Dank
GJ-Werner

    Dim Prompt As String
    Dim Item As Object
   
    Dim zylyinderachse As AcadLine
    Dim hilfslinie As AcadLine
   
   
    Dim pkta As Variant
    Dim pktb As Variant
    Dim pktc As Variant
    Dim pktd As Variant
   
    Dim stationspkt(0 To 2) As Double
    Dim zylstart(0 To 2) As Double
    Dim zylende(0 To 2) As Double
    Dim hilfspunkt(0 To 2) As Double
   
    Dim refposition(2) As Double
   
    Set model = ThisDrawing.ModelSpace
   
    Prompt = "Bitte wählen Sie den Stationspunkt aus:"
    ThisDrawing.Utility.GetEntity Item, OutPoint, Prompt
    pkta = Item.InsertionPoint
    stationspkt(0) = pkta(0)
    stationspkt(1) = pkta(1)
    stationspkt(2) = pkta(2)
   
    Prompt = "Bitte wählen Sie den STARTpunkt der Zylinderachse aus:"
    ThisDrawing.Utility.GetEntity Item, OutPoint, Prompt
    pktb = Item.InsertionPoint
    zylstart(0) = pktb(0)
    zylstart(1) = pktb(1)
    zylstart(2) = pktb(2)
       
    Prompt = "Bitte wählen Sie den ENDpunkt der Zylinderachse aus:"
    ThisDrawing.Utility.GetEntity Item, OutPoint, Prompt
    pktc = Item.InsertionPoint
    zylende(0) = pktc(0)
    zylende(1) = pktc(1)
    zylende(2) = pktc(2)
       
    Prompt = "Bitte wählen Sie den HILFSPKT aus:"
    ThisDrawing.Utility.GetEntity Item, OutPoint, Prompt
    pktd = Item.InsertionPoint
    hilfspunkt(0) = pktd(0)
    hilfspunkt(1) = pktd(1)
    hilfspunkt(2) = pktd(2)
       
       
    Dim aktlyer As ACAD_LAYER
    Set aktlayer = ThisDrawing.Layers("ZylinderAchse_Bezugssystem")
    ThisDrawing.ActiveLayer = aktlayer

    ' HINWEIS: Die Zylinderachse ist schräg und das BKS soll in dieser Ebene liegen,
    '  daher wird die Linie versetzt bzw. der Hilfspunkt vorher erzeugt, um für das
    '  BKS einen Rechtswert gleicher Höhe zu erhalten)

   
    Set zylinderachse = model.AddLine(pktb, pktc)
    Set hilfslinie = model.AddLine(pktb, pktd)
       
   
    'Dim parallele As AcadLine
    'Set parallele = zylinderachse.Offset(-1)
    ' Linie wird um einen Meter nach rechts versetzt, aber trotzdem
    ' Fehlermeldung Objekt erforderlich ???
   
   
    Dim bksnull(2) As Double
    Dim bksrechts(2) As Double
    Dim bkshoch(2) As Double
   
    bksnull(0) = zylstart(0)
    bksnull(1) = zylstart(1)
    bksnull(2) = zylstart(2)
   
    bksrechts(0) = hilfspunkt(0)
    bksrechts(1) = hilfspunkt(1)
    bksrechts(2) = hilfspunkt(2)

    bkshoch(0) = zylende(0)
    bkshoch(1) = zylende(1)
    bkshoch(2) = zylende(2)
   
    MsgBox (zylstart(2))
    MsgBox (zylende(2))
   
    Dim bksA As String
    bksA = "systemA"
    ThisDrawing.ActiveUCS = ThisDrawing.UserCoordinateSystems.Add(bksnull, bksrechts, bkshoch, bksA)
    ThisDrawing.ActiveUCS = ThisDrawing.UserCoordinateSystems(bksA)
    MsgBox (bksA)
    ThisDrawing.SendCommand ("drsicht a ")
    MsgBox ("bks Draufsicht klappt")

    Dim eins As Variant
    Dim zwei As Variant
    Dim start(0 To 2) As Double
    Dim startz(0 To 2) As Double
    Dim ende(0 To 2) As Double
   
    eins = hilfslinie.StartPoint
    zwei = hilfslinie.EndPoint
    eins = ThisDrawing.Utility.TranslateCoordinates(eins, acWorld, acUCS, False)
    zwei = ThisDrawing.Utility.TranslateCoordinates(zwei, acWorld, acUCS, False)
   
    start(0) = eins(o)
    start(1) = eins(1)
    start(2) = eins(2)
   
    ende(0) = zwei(o)
    ende(1) = zwei(1)
    ende(2) = zwei(2)
   
    startz(0) = eins(0)
    startz(1) = eins(1)
    startz(2) = eins(2) + 10
   
    bksB = "systemB"
    ThisDrawing.ActiveUCS = ThisDrawing.UserCoordinateSystems.Add(start, ende, startz, bksB)
    MsgBox (bksB)
    ThisDrawing.SendCommand ("drsicht a ")
    MsgBox ("umklappen geht auch")
   
   
    Dim zylkreis As AcadCircle
    Dim radius As Double
    radius = 4.5
    Set aktlayer = ThisDrawing.Layers("Zylinder")
    ThisDrawing.ActiveLayer = aktlayer
    Set zylkreis = ThisDrawing.ModelSpace.AddCircle(start, radius)
       
    ThisDrawing.SendCommand ("_extrude" & vbCr & "letztes" & vbCr & vbCr & "-2" & vbCr)
     
    ThisDrawing.SendCommand ("bks" & vbCr & "welt" & vbCr & "drsicht a ")
    MsgBox ("draufsicht welt")

------------------
D. Werner

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

---

Hi,

kannst Du bitte:

Deine Systeminfo ausfüllen, damit wir wissen, womit Du überhaupt arbeitest (AutoCAD-Art und -Version).

Dann hätte ich beim Überfliegen gesehen, dass das BKS setzen wahrscheinlich nur einmal funktioniert, denn gibt es das BKS namens 'systemA' oder 'systemB' schon mal, wird es nicht mehr überschrieben.

Weiters interessant, ob die abgefragten Punkte 2D oder 3D sind (kann ev. beim Offset einen Unterschied machen) ==> Schreib dazu mal die Koordinaten neben die Variable, mit denen es nicht funktioniert. Damit wird das Reproduzieren für uns leichter. 

- alfred -

------------------
www.hollaus.at

---

Hi alfred,
die Punkte sind 3D Punkte (Blockreferenzen)und die Benutzerkoordinatensysteme
gibt es vorher noch nicht. Das schwierige für mich ist, im erstellten BKS A, das
BKS B richtig zu erstellen.
Die Punkte ursprünglich sind
Zylstart(3537129.773,5582363.214,289.923)
Zylende(3537130.273,5582363.995,289.928)
Hilfspunkt(3537130.615,5582362.675,289.923)
Der Hilfspunkt wurde vorher nur erzeugt, da das versetzten der Linie von Zylstart nach Zylende
mit weiterverwndug der Kkordinaten nicht ging)

Im BKS A soll sein
Zylstart(0,0,0)
Hilfspunkt(1,0,0)
Zylende(0,0.927,0) (0.927 entfernung zylstart-zylende)

es wird nun ein punkt erzeugt mit gleicher lage wie zylstart
und höhenoffset z.B. 10 (wert ist nicht so wichtig, es geht nur um die ausrichtung für bks B)

Im BKS B soll sein

zylstart(0,0,0)
hilfspunkt(1,0,0)
hochpunkt(0,0,10)

Soweit erstmal. Ich hoffe, das ist so verständlich. Ziel ist. Ich möchte ein BKS
mit z richtung der Linie ZylStart nach Zylende

Ich arbeite mit Autodeskmap3D und windows XP

Viele Grüße
GJ-Werner

------------------
D. Werner

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

---

Hi,

mal die Punkte, die mir beim Durchlauf (mit Deinen Testwerten) auffallen:

a) BKS mehrmals unterschiedlich setzen mit gleichem Namen geht imho nicht, probieren bitte, bin jetzt nicht 100% sicher.

b) das Offset eines Elements retourniert nicht eine AcadLine, sondern ein Array von AcadEntities. Damit musst Du das so umschreiben:

Code:

---

  Dim parallele As Variant  'Offset liefert ein Array von Elementen retour, nicht ein einzelnes Objekt!
  parallele = zylinderachse.Offset(-1)
 
  Dim hilfspunkt As Variant
  If Not IsEmpty(parallele) Then
      Dim tLine As AcadLine
      Set tLine = parallele(0)
      hilfspunkt = tLine.StartPoint
      '....

---

Wichtig: das funktioniert auch nur dann, wenn das Basiselement eine Linie ist, bei Polylinie oder anderen Elementen muss man viel mehr checken. 

c) Der letzte Fehler entsteht eigentlich durch Deinen Umweg mit der Hilfspunktrechnung, denn es wird versucht, ein nicht rechtwinkeliges Koordinatensystem zu erstellen und das lässt AutoCAD nicht zu (zumindest nicht mit VBA und sonst auch nur, wenn man sich Probleme einhandeln will ), das sollte aber durch das jetzt funktionierende Versetzen auch gelöst sein, wenn Du den Startpunkt der versetzten Linie statt Deinem Hilfspunkt verwendest.

Bitte grundsätzlich Variable ordentlich deklarieren, dann kommst Du bereits beim Testen schneller zu Deklarationsfehlern. Zumindest in dem hier gezeigten Beispiel haben da ein paar Deklarationen gefehlt (z.B. model).

HTH & viel Erfolg, - alfred -

------------------
www.hollaus.at

---

Hallo alfred,
vielen Dank für Deine Antwort, ich bin das ganze nochmal durchgegangen.
Set model=ThisDrawing.ModelSpace habe ich eingefügt.
Mit dem Linie versetzen das klappt jetzt prima und ich kann auch die Koordinaten
der Linien start- und endpunkte für mein BKS weiterverarbeiten.
Ich musste noch weitere BKS erstellen und habe da gemerkt, dass im aktuellen BKS
der Befehl sendcommand beim linie zeichnen die richtigen Koordinaten zeichnet.
Mit Hilfe dieser Linien start- und endpunkte konnte ich weitere BKS erstellen.
Auch die Bezeichnungen für die einzelnen BKS habe ich überarbeitet. So klappt das.
Nun bastel ich noch weiter, um verschiedene Ansichtsfenster für die BKS zu definieren.
Ganz vielen Dank
viele Grüße
GJ-Werner
10 Unitys für Dich

------------------
D. Werner

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