Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  Lisp
  Polylinie ... Schnittpunkte ???

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:  Polylinie ... Schnittpunkte ??? (3195 mal gelesen)
edo2000
Mitglied



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

Beiträge: 38
Registriert: 05.03.2003

erstellt am: 27. Okt. 2012 21:22    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


BSP.pdf

 
Hallo Leute ...

irgend wie Habe ich 'n geometrischen BlackOut       und komme einfach nicht weiter. Und was Lisp betrifft sind mir nur die "Basic's" Vertraut    
Zum Vorhaben:
Gegeben ist eine Polylinie (Trasse) und sozusagen 2 Wagons die über eine Stange verbunden sind. Hierzu siehe angehängte Prinzip-Skizze. L1, L2 und L3 sind feste Größen die sich entlang der Trasse bewegen.
Ich Starte am Anfang der Polyline und möchte die Punkte P1 bis P4 in gewissen Abschnitten ermitteln.
Mit einem Hilfsbogen und Mapcar's http://www.visuallisp-tutorial.mapcar.net/intersect.html  Beispiel, sind die P1 und P2 kein Problem.

hier ein Auszug ...

Code:

... 
  (while (< (+ zz L1) Poly-Länge)
    (setq PW-e (vlax-curve-getPointAtDist obj zz)
  PW-a (vlax-curve-getPointAtDist obj (+ zz L1))
  )
    (setq ri (angle PW-e PW-a))
    (if (or                     ;;; Gerade Bereiche vernachlässigen
  (= ri pi)
  (= ri 0))
      "nix"
      (progn
(command "_arc"          ;;; Hilfsbogen ... mit R = L1
(polar PW-e (- ri (wib 15)) L1)
(polar PW-e ri L1)
(polar PW-e (+ ri (wib 15)) L1)
)
(setq obj2 (entlast))
(setq SP (foreach p (intersect2 obj1 obj2) p ))
(entdel obj2)
(command "_line" PW-e SP "") ;;; Test-Linie
)
      )
    (setq zz (+ zz Schritte))
    )
...

Aber für P3 und P4 stehe ich auf'm Schlauch.    

EDIT ::: Hab vergessen zu erwähnen: Die grünen Kreise sind natürlich Gelenke !  

Wie würdet Ihr vorgehen ... ??? Für jeden Tipp bin ich dankbar         

------------------
@edo...

..............................................
SO EINFACH WIE MÖGLICH, ABER NICHT EINFACHER !
..............................................

[Diese Nachricht wurde von edo2000 am 27. Okt. 2012 editiert.]

[Diese Nachricht wurde von edo2000 am 27. Okt. 2012 editiert.]

[Diese Nachricht wurde von edo2000 am 27. Okt. 2012 editiert.]

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

joern bosse
Ehrenmitglied
Dipl.-Ing. Vermessung


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

Beiträge: 1734
Registriert: 11.10.2004

Window 10
ACAD 2021
CIVIL 2021
BricsCAD V14-V22
Intel(R) Core(TM)i5-8250U CPU @ 1.60GHz 1.80 GHz
16.0GB RAM
NVIDIA GeForce GTX 1050<P>

erstellt am: 29. Okt. 2012 10:03    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 edo2000 10 Unities + Antwort hilfreich

Hallo Edo,
das ist ja mal eine nette Aufgabe.
Zitat:

(setq PW-e (vlax-curve-getPointAtDist obj zz)
  PW-a (vlax-curve-getPointAtDist obj (+ zz L1))

Ich bin der Meinung, hier wird schon gleich zu Beginn der Winkel "ri" falsch berechnet, weil Du für die Punkte PW-e und PW-a die Länge auf der Polylinie verwendest und nicht die wahre WaggonLänge L1 (auf dem Bogen ist die Strecke dann länger, daraus resultierend ist je nach Bogenverlauf der abgeleitete Winkel "ri" größer oder kleiner.

Aber weil Du ja eine "Test-Linie" erzeugst gehe ich davon aus, daß Du damit erstmal zum korrekten Ziel gekommen bist

Ich würde vielleicht den Punkt "P2" iterativ erzeugen. Mit folgender Funktion bekommst Du in aufsteigender Richtung den Punkt P2 erzeugt, wobei die WaggonLänge auf 10 (Einheiten) gesetzt ist. Es wird immer die halbe Differenz zwischen dem Abstand "P1" und "P2" der Länge auf der Polylinie auf den Wert von "l1Poly" draufgeschlagen.

Code:

(defun c:test ( / ABSTANDIST DISTATPKT1 L1 L1POLY OBJ PKT PKT2 RETVALCHECK)
  (setq l1 10.0)
  (if (and (setq obj (car(entsel "\nPolylinie auswählen:")))
          (member(cdr(assoc 0 (entget obj)))'("LWPOLYLINE" "POLYLINE"))
          (setq pkt (getpoint "\nStartPunkt:"))
          (setq pkt (vlax-curve-getClosestPointTo obj pkt)))
    (progn
      (setq l1Poly l1
            DistAtPkt1 (vlax-curve-GetDistAtPoint obj pkt))
      (while (not pkt2)
        (if (setq retvalCheck
          (test:AbstandCheck pkt obj l1Poly DistAtPkt1 l1))
          (progn
            (setq AbstandIst (cadr retvalCheck)
                  pkt2 (car retvalCheck))
            (if (not pkt2)
              (setq l1Poly (+ (/ (- l1 AbstandIst) 2.0)l1Poly))))
          (progn
          (alert "Der zweite Punkt befindet sich nicht auf der Poly")
            (exit))))

      ;;;Kontroll-Linie
      (entmake (list '(0 . "LINE")
                    (cons 10 pkt)
                    (cons 11 pkt2))))))

   

(defun test:AbstandCheck (pkt obj l1Poly DistAtPkt1 l1 /
    ABSTANDIST PKT2)
  (if(and(setq pkt2 (vlax-curve-getPointAtDist obj
                      (+ DistAtPkt1 l1Poly)))
        (setq AbstandIst (distance pkt pkt2)))
    (if (equal l1 AbstandIst 0.0000001)
      (list pkt2 AbstandIst)
      (list nil AbstandIst))))



Und für den weiteren Verlauf würde ich vielleicht auch eine Iteration verwenden, den Waggon auf eine sinnvolle Startposition setzen und dann solange wiederholen, bis der Abstand "L3" passt.

Vielleicht liest hier ja noch ein Schlauer mit, der das ganz mathematisch lösen kann, eine Iteration ist meiner Meinung nach immer ein wenig unelegant

------------------
viele Grüße

Jörn
http://www.bosse-engineering.com

VektorAdd-HD-Youtube

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

CAD-Huebner
Ehrenmitglied V.I.P. h.c.
Verm.- Ing., ATC-Trainer



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

Beiträge: 9732
Registriert: 01.12.2003

One AutoCAD 2.5 - 2023, Civil 3D, Win10/win11

erstellt am: 29. Okt. 2012 10:41    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 edo2000 10 Unities + Antwort hilfreich


UH-Parameter.gif

 
Um nur an versch. Punkten der Trasse die Koordinten der Linienenden zu ermitteln, braucht es in diesem Fall vielleicht gar keine Programmierung.
U.U. reichen ja AutoCAD Bordmittel - hier Parameter.

------------------
Mit freundlichem Gruß

Udo Hübner
www.CAD-Huebner.de

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

edo2000
Mitglied



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

Beiträge: 38
Registriert: 05.03.2003

erstellt am: 29. Okt. 2012 11:06    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


Trasse.dwg

 
@ Jörn,
danke für die Antwort und die moralische Unterstützung  

Also mathematische Lösung habe ich auch nicht parat 
PS: die Richtung "RI" nutze ich nur um den Hilfsbogen zu zeichnen und daraus den Schnittpunkt zu ermitteln .

Letztendlich habe ich es dann auch mit Iteration versucht ...

kurze Beschreibung :
- Geometriedaten der Polylinie ermitteln
- 1. Schleife um P1, P2 und G1 in gewissen Abständen zu ermitteln
- 2. Unterschleife um sich an P3, P4 und G2 zu heran-tasten (mit kleineren Abständen und zul. Abweichung)

Der Nachteil ... je kleiner die zul. Abweichung und die kleineren Abstände sind desto mehr leidet die Performance  

Hier der bisherige ganze CODE

Code:
(defun WIB (Win)  (* pi (/ Win 180.0))  )
(defun BIW (Rad)  (* 180.0 (/ Rad pi))  )

;;; Aus Liste wird Listenpaaren
(defun gather(ls len / tmp rl i)
  (setq i 0)
  (foreach item ls
    (setq tmp(append tmp(list item)))
    (setq i(1+ i))
    (if(zerop(rem i len))  (setq rl(cons tmp rl) tmp nil)
    ))
  (reverse rl)
  )

;;; Schnittpunkte ermitteln
(defun intersect (ent1 ent2 / ar)
  (vl-load-com)
  (setq ar (vlax-invoke-method
     (vlax-ename->vla-object ent1)
     'IntersectWith
     (vlax-ename->vla-object ent2)
     acExtendNone
     ) )
  (if (/= -1 (vlax-safearray-get-u-bound (vlax-variant-value ar) 1))
    (gather (vlax-safearray->list (vlax-variant-value ar)) 3)    )
  )

;;; Curve/Poly-Daten ermitteln
(defun poly_koor (obj / koord koord_vla koord_vla_S)
  (vl-load-com)
  (setq obj (vlax-ename->vla-object obj))
  (setq koord
(vlax-safearray->list
   (vlax-variant-value
     (vla-get-coordinates Obj)
     ) ) )
  (setq n 0)
  (repeat (/ (length koord) 2)
    (setq koord_vla (cons (list (nth n koord) (nth (+ n 1) koord) 0.0 ) koord_vla)
  n  (+ n 2) )
    )
  (setq n -1)
  (setq koord_vla (reverse koord_vla))
  (repeat (length koord_vla)
    (setq koord_vla_S(cons (list (vlax-curve-getdistAtParam Obj (setq n(1+ n)))
(car koord_vla))
   koord_vla_S)
  )
    (setq koord_vla (cdr koord_vla))
    )
  koord_vla_S
  )

(defun C:WOBT ( / poly poly_kor_S S-P E-P Länge L1 L2 L3 Schritte1 Schritte2 zz1 zz2 ri1 ri2 P1 P2 P3 P4 Px Py G1 G2 Gx)
  (setq $clayer (getvar "CLAYER")
$osmode (getvar "OSMODE")
$ucsicon  (getvar "UCSICON")
$cmdecho  (getvar "CMDECHO"))
  (setvar "UCSICON" 0)
  (setvar "OSMODE"  0)
  (setvar "CMDECHO" 0)
  (command "._undo" "_g") 
  (vl-load-com)
  (setq poly (car (entsel "\nBitte Polylinie wählen:")))
  (setq poly_kor_S (reverse (poly_koor poly))) ;;; Poly-Datenermittlung (Station, Koordinaten)
  (setq S-P (cadr (car poly_kor_S))
E-P (cadr (last poly_kor_S))
Länge (car (last poly_kor_S))
L1 7645
L2 1225
L3 3240
Schritte1 2000
Schritte2 5)
  (setq zz1 2000
zz2 0)
  (while (< (+ zz2 L1 2000) Länge)
    (setq P1 (vlax-curve-getPointAtDist poly zz1)
  Px (vlax-curve-getPointAtDist poly (+ zz1 L1))
  )
    (setq ri1 (angle P1 Px))
    (command "_arc"
     (polar P1 (- ri1 (wib 15)) L1)
     (polar P1 ri1 L1)
     (polar P1 (+ ri1 (wib 15)) L1)
     )
    (setq obj2 (entlast))
    (setq P2 (foreach p (intersect poly obj2) p )) ;;; mapcar's Schnittpunktermittlung
    (entdel obj2)
    (setq G1 (polar P2 (angle P1 P2) L2))
    (setvar "cecolor" "8")
    (command "_arc"
     (polar G1 (- ri1 (wib 70)) L3)
     (polar G1 ri1 L3)
     (polar G1 (+ ri1 (wib 70)) L3)
     )
    (setq curve-obj (entlast))
    (setq zz2 (+ zz1 L1 L2 L3 )
  G2 nil
  Gx nil)
    (while (if (or (= G2 nil) (= Gx nil))
     T
     (> (distance G2 Gx) 10)) ; <---- Zulässige Abweichung für L3 ... 10 mm
      (setq P3 (vlax-curve-getPointAtDist poly zz2)
    Py (vlax-curve-getPointAtDist poly (+ zz2 L1))
    )
      (setq ri2 (angle P3 Py))
      (command "_arc"
       (polar P3 (- ri2 (wib 15)) L1)
       (polar P3 ri2 L1)
       (polar P3 (+ ri2 (wib 15)) L1)
       )
      (setq obj3 (entlast))
      (setq P4 (foreach p (intersect poly obj3) p )) ;;; mapcar' Schnittpunktermittlung
      (entdel obj3)
      (setq G2 (polar P3 (angle P4 P3) L2))
      (setq Gx (vlax-curve-getClosestPointTo curve-obj G2))
      (setq zz2 (+ zz2 Schritte2))
      )
    (entdel curve-obj)
    (setvar "cecolor" "gelb")
    (command "_Pline" P1 P2 G1 G2 P3 P4 "")
    (setq zz1 (+ zz1 Schritte1))
    )
  (command "._undo" "_e")
  (setvar "CLAYER"  $clayer)
  (setvar "OSMODE"  $osmode)
  (setvar "UCSICON" $ucsicon)
  (setvar "CMDECHO" $cmdecho)
  )

(prompt"\nWOBT zum Starten.")(princ)


@Udo ... danke für den Hinweis ... aber ich brauche die Punkte als Liste um weiter darauf aufzubauen (Schleppkurve etc.). Eine Frage noch in deiner GIF Folgen nicht alle Punkte (P1.P4) der Polylinie ... Ein Versehen ?

EDIT: Da mir nicht alle VL-Funktionen geläufig sind, gibt es evtl. eine andere Möglichkeit um die Performance zu schonen ? Eine Test-Trasse liegt ebenfalls bei :::

------------------
@edo...

..............................................
SO EINFACH WIE MÖGLICH, ABER NICHT EINFACHER !
..............................................

[Diese Nachricht wurde von edo2000 am 29. Okt. 2012 editiert.]

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

joern bosse
Ehrenmitglied
Dipl.-Ing. Vermessung


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

Beiträge: 1734
Registriert: 11.10.2004

Window 10
ACAD 2021
CIVIL 2021
BricsCAD V14-V22
Intel(R) Core(TM)i5-8250U CPU @ 1.60GHz 1.80 GHz
16.0GB RAM
NVIDIA GeForce GTX 1050<P>

erstellt am: 29. Okt. 2012 12:12    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 edo2000 10 Unities + Antwort hilfreich

@Udo
tolle Sache das mit den Parametern, habe ich leider bisher immer links liegen gelassen, nehme mir aber ganz fest vor, mich demnächst mal damit zu beschäftigen.

@Edo
Ich wollte es jetzt auch nochmal wissen, ich habe die Testfunktion von heute morgen weitergebaut, mit Deiner Test-DWG hat's funktioniert. vielleicht hilft es Dir ein bißchen weiter.

Code:

(defun c:test ( / ABSTAND ABSTANDIST FUZZ L1 L2 L3 OBJ P1 P2 P3 P4 )
  (setq L1 7645.0
        L2 1225.0
        L3 3240.0
        Fuzz 0.0000001)
 
  (if (and (setq obj (car(entsel "\nPolylinie auswählen:")))
          (member(cdr(assoc 0 (entget obj)))'("LWPOLYLINE" "POLYLINE"))
          (setq P1 (getpoint "\nStartPunkt:"))
          (setq P1 (vlax-curve-getClosestPointTo obj P1)))
    ;;;Wenn Punkt2 (P2) von Waggon 1
    (if (setq P2 (test:WaggonP2 P1 obj L1 Fuzz))
      (progn
       
        (setq Abstand L3)
        ;;;Waggon 2 erster Punkt als Startwert (P3)
        (setq P3 (vlax-curve-getPointAtDist obj
                  (+(vlax-curve-GetDistAtPoint obj P2)
                    (apply '+ (list L2 Abstand L2)))))
       
        (while (and(setq P4 (test:WaggonP2 P3 obj L1 Fuzz))
                  (not(equal L3 (setq AbstandIst(distance
                                  (polar P2 (angle P1 P2)L2)
                                  (polar P3 (angle P4 P3)L2))) Fuzz)))
          (setq Abstand (+ (/ (- L3 AbstandIst) 2.0)Abstand)
                P3 (vlax-curve-getPointAtDist obj
                    (+(vlax-curve-GetDistAtPoint obj P2)
                      (apply '+ (list L2 Abstand L2))))))

       
        ;;;KontrolLinien zeichnen
        (test:LineEntmake P1 P2)
        (test:LineEntmake P2 (polar P2 (angle P1 P2)L2))
        (test:LineEntmake (polar P2 (angle P1 P2)L2)
                          (polar P3 (angle P4 P3)L2))
        (test:LineEntmake (polar P3 (angle P4 P3)L2) P3)
        (test:LineEntmake P3 P4)
         
         

       
        )
        )
      )
    )
 

(defun test:LineEntmake (p1 p2 / )
  (entmake(list (cons 0 "LINE")
                (cons 10 P1)
                (cons 11 P2))))

;;;2. Punkt eines Waggons bestimmen
(defun test:WaggonP2 (P1 obj L1 Fuzz / ABSTANDIST DISTATP1 L1POLY P2 RETVALCHECK)
  (setq L1Poly L1
        DistAtP1 (vlax-curve-GetDistAtPoint obj P1))
  (while (not P2)
    (if (setq retvalCheck(test:WaggonP2:AbstandCheck P1 obj L1Poly DistAtP1 L1 Fuzz))
      (progn
        (setq AbstandIst (cadr retvalCheck)
              P2 (car retvalCheck))
        (if (not P2)
          (setq L1Poly (+ (/ (- L1 AbstandIst) 2.0)L1Poly))))
          (progn
            (alert "Der WaggonPunkt befindet sich nicht auf der Poly")
            (exit))))
  P2

      ) 

(defun test:WaggonP2:AbstandCheck (P1 obj L1Poly DistAtP1 L1 Fuzz / ABSTANDIST P2)
  (if(and(setq P2 (vlax-curve-getPointAtDist obj
                      (+ DistAtP1 L1Poly)))
        (setq AbstandIst (distance P1 P2)))
    (if (equal L1 AbstandIst Fuzz)
      (list P2 AbstandIst)
      (list nil AbstandIst))))



PS: Ich habe nicht geprüft, ob die Iteration auch ins leere Laufen kann, also vorher alles wichtige in der AutoCAD-Sitzung speichern

------------------
viele Grüße

Jörn
http://www.bosse-engineering.com

VektorAdd-HD-Youtube

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

edo2000
Mitglied



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

Beiträge: 38
Registriert: 05.03.2003

erstellt am: 29. Okt. 2012 13:12    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

Zitat:
Original erstellt von joern bosse:
@Edo
Ich wollte es jetzt auch nochmal wissen, ich habe die Testfunktion von heute morgen weitergebaut, mit Deiner Test-DWG hat's funktioniert. vielleicht hilft es Dir ein bißchen weiter.

Hallo Jörn .....

Es FunZT  ...
Habe deine Iteration eingebaut (Aufruf in gewissen Abständen z.B. 300 entlang der Poly) und es ist kein Vergleich zu meiner Schleife, was die Performance angeht ...

Besten Dank nochmals ! 


------------------
@edo...

..............................................
SO EINFACH WIE MÖGLICH, ABER NICHT EINFACHER !
..............................................

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

joern bosse
Ehrenmitglied
Dipl.-Ing. Vermessung


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

Beiträge: 1734
Registriert: 11.10.2004

Window 10
ACAD 2021
CIVIL 2021
BricsCAD V14-V22
Intel(R) Core(TM)i5-8250U CPU @ 1.60GHz 1.80 GHz
16.0GB RAM
NVIDIA GeForce GTX 1050<P>

erstellt am: 29. Okt. 2012 15:13    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 edo2000 10 Unities + Antwort hilfreich

Hallo Edo,
schön das es funzt. Wegen der Performance noch ein Tip: alle Command-Aufrufe vermeiden wo es geht, die bremsen Acad ganz schön aus. Soll aber nicht heißen, daß man nicht hier und da mal einzelne Command's einbauen kann, nur in so einer Schleife, die zigmal durchlaufen wird wirkt es sich dann schon sehr negativ aus.

------------------
viele Grüße

Jörn
http://www.bosse-engineering.com

VektorAdd-HD-Youtube

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

edo2000
Mitglied



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

Beiträge: 38
Registriert: 05.03.2003

erstellt am: 30. Okt. 2012 16:25    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

Zitat:
Original erstellt von CAD-Huebner:
Um nur an versch. Punkten der Trasse die Koordinten der Linienenden zu ermitteln, braucht es in diesem Fall vielleicht gar keine Programmierung.
U.U. reichen ja AutoCAD Bordmittel - hier Parameter.

Habe ich mal getestet ... Prima Sache,
jedoch funktioniert es nur mit Splines  und einfachen Geometrien ... Bei Polylinien werden die Zusammenfallende Punkte nur an Untergruppen (Kreisbogen, Linie) verankert ...

------------------
@edo...

..............................................
SO EINFACH WIE MÖGLICH, ABER NICHT EINFACHER !
..............................................

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

nebuCADnezzar
Mitglied



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

Beiträge: 262
Registriert: 17.10.2007

AutoCAD 2019
Inventor 2019
64 bit Win 10
Intel I7 10610U 1.8 GHz
Quadro P520
32 GB Ram

erstellt am: 26. Mrz. 2014 16:52    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 edo2000 10 Unities + Antwort hilfreich

Hallo

Das Lisp macht schon fast was ich brauche, aber ich hab schon n Jahr oder mehr nichts mehr gelispelt.
Ich steh grad auf m Schlauch, hab das Ding schon so angepasst, verkleinert zu meinen Zwecken, nun hänge ich aber an ner blöden Schleife, hab schon n weilchen gefummelt aber ich bekomm nicht raus was
"defun test:WaggonP2" ausgibt um da ne Schleife einzubauen das bis zum Ende der Polylinie Linien gezeichnet werden.
Die Linien sollen später im nächsten Schritt dann noch durch einen Block ersetzt werden...

Hab hier http://ww3.cad.de/foren/ubb/Forum54/HTML/031061.shtml#000003 die Frage gestellt und bin nun auf diese Lisplösung gesossen...

Gruss Nebu

Code:

(defun c:test ( / ABSTAND ABSTANDIST FUZZ L1 L2 L3 OBJ P1 P2 P3 P4 )
  (setq L1 4014.0
        Fuzz 0.0000001)

  (if (and (setq obj (car(entsel "\nPolylinie auswählen:")))
          (member(cdr(assoc 0 (entget obj)))'("LWPOLYLINE" "POLYLINE"))
          (setq P1 (getpoint "\nStartPunkt:"))
          (setq P1 (vlax-curve-getClosestPointTo obj P1)))
    ;;;Wenn Punkt2 (P2) von Waggon 1
    (if (setq P2 (test:WaggonP2 P1 obj L1 Fuzz))
        ;;;KontrolLinien zeichnen
        (test:LineEntmake P1 P2)
)

    )

(setq P1 P2)
  (WHILE ????????????????????) ;AHAHAHHAHAHAHHAHAHAHA MENO! HRRRR
    (if (setq P2 (test:WaggonP2 P1 obj L1 Fuzz))
        ;;;KontrolLinien zeichnen
        (test:LineEntmake P1 P2)
)

 
)


(defun test:LineEntmake (p1 p2 / )
  (entmake(list (cons 0 "LINE")
                (cons 10 P1)
                (cons 11 P2))))

;;;2. Punkt eines Waggons bestimmen
(defun test:WaggonP2 (P1 obj L1 Fuzz / ABSTANDIST DISTATP1 L1POLY P2 RETVALCHECK)
  (setq L1Poly L1
        DistAtP1 (vlax-curve-GetDistAtPoint obj P1))
  (while (not P2)
    (if (setq retvalCheck(test:WaggonP2:AbstandCheck P1 obj L1Poly DistAtP1 L1 Fuzz))
      (progn
        (setq AbstandIst (cadr retvalCheck)
              P2 (car retvalCheck))
        (if (not P2)
          (setq L1Poly (+ (/ (- L1 AbstandIst) 2.0)L1Poly))))
          (progn
            (alert "Der WaggonPunkt befindet sich nicht auf der Poly")
            (exit))))
  P2

      )

(defun test:WaggonP2:AbstandCheck (P1 obj L1Poly DistAtP1 L1 Fuzz / ABSTANDIST P2)
  (if(and(setq P2 (vlax-curve-getPointAtDist obj
                      (+ DistAtP1 L1Poly)))
        (setq AbstandIst (distance P1 P2)))
    (if (equal L1 AbstandIst Fuzz)
      (list P2 AbstandIst)
      (list nil AbstandIst))))



------------------
...glaubst das ist luft die du gerade atmest? in diesem raum...

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

nebuCADnezzar
Mitglied



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

Beiträge: 262
Registriert: 17.10.2007

AutoCAD 2019
Inventor 2019
64 bit Win 10
Intel I7 10610U 1.8 GHz
Quadro P520
32 GB Ram

erstellt am: 26. Mrz. 2014 19:02    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 edo2000 10 Unities + Antwort hilfreich

HABS GESCHAFFT!!!! YYYEEEEEHA :-)

Und Morgen muss ich noch was Bauen damit von Block zu Block max 3° unterschied möglich sind!

Code:

(defun c:test (/ ABSTAND ABSTANDIST FUZZ L1 L2 L3 OBJ P1 P2 P3 P4 RAD)
  (setq L1 4014.0
        Fuzz 0.0000001)
 
  (if (and (setq obj (car(entsel "\nPolylinie auswählen:")))
          (member(cdr(assoc 0 (entget obj)))'("LWPOLYLINE" "POLYLINE"))
          (setq P1 (getpoint "\nStartPunkt:"))
          (setq P1 (vlax-curve-getClosestPointTo obj P1)))
    ;;;Wenn Punkt2 (P2) von Waggon 1
    (if (setq P2 (test:WaggonP2 P1 obj L1 Fuzz))
      (progn
        ;;;KontrolLinien zeichnen
        (test:LineEntmake P1 P2)
        (setq RAD (angle P1 P2))
  (setq WIN (atof (angtos rad 0 2)))
(command "_.insert" "Panel 4m" P1 1 1 WIN)

      )
    )
  )

 
)

(defun test:LineEntmake (p1 p2 / )
  (entmake(list (cons 0 "LINE")
                (cons 10 P1)
                (cons 11 P2))))

;;;2. Punkt eines Waggons bestimmen
(defun test:WaggonP2 (P1 obj L1 Fuzz / ABSTANDIST DISTATP1 L1POLY P2 RETVALCHECK)
  (setq L1Poly L1
        DistAtP1 (vlax-curve-GetDistAtPoint obj P1))
  (while (not P2)
    (if (setq retvalCheck(test:WaggonP2:AbstandCheck P1 obj L1Poly DistAtP1 L1 Fuzz))
      (progn
        (setq AbstandIst (cadr retvalCheck)
              P2 (car retvalCheck))
        (if (not P2)
          (setq L1Poly (+ (/ (- L1 AbstandIst) 2.0)L1Poly))))
          (progn
            (alert "Der WaggonPunkt befindet sich nicht auf der Poly")
            (exit))))
  P2

      )

(defun test:WaggonP2:AbstandCheck (P1 obj L1Poly DistAtP1 L1 Fuzz / ABSTANDIST P2)
  (if(and(setq P2 (vlax-curve-getPointAtDist obj
                      (+ DistAtP1 L1Poly)))
        (setq AbstandIst (distance P1 P2)))
    (if (equal L1 AbstandIst Fuzz)
      (list P2 AbstandIst)
      (list nil AbstandIst))))


------------------
...glaubst das ist luft die du gerade atmest? in diesem raum...

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)2023 CAD.de | Impressum | Datenschutz