Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  Lisp
  2d Rohrbogen

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
Autor Thema:   2d Rohrbogen (3569 mal gelesen)
HANS at Stmk
Mitglied
Techniker

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

Beiträge: 4
Registriert: 09.04.2005

erstellt am: 09. Apr. 2005 19:28    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 Leute,
ich bin neu im Forum und ein Anfänger in Lisp, brauche deshalb professionelle Hilfe beim erstellen einer Routine zum zeichnen eines 2d-Rohrbogens mit folgendem Ablauf:
nach Eingabe der Nennweite (z. B. 100) soll der Befehl abrunden aufgerufen werden. Dann nach anklicken von 2 Linien (erste u. zweite Rohrmitte) soll auf den Layer der angeklickten Linien gewechselt (wenn nicht auf gleichem Layer, Meldung) und die beiden Linien mit rb (für Nennweite 100 ist das 152.5) abgerundet werden.
Danach den Bogen um den halben Rohrdurchmesser rr (für Nennweite 100 ist das 114.3) auf jede Seite versetzen und zwischen den Enden der beiden versetzten Bögen je eine Linie zeichnen (Farbe und LT der beiden versetzten Bögen und der beiden Linien "von Layer".)


(defun c:RB ()
(setq colold (getvar "cecolor"))
(setq ltold (getvar "celtype"))
(setq lay (getvar "clayer"))
(setq dn (getint "\nNennweite eingeben : "))
        (setq liste '
;erstes listelement Nennweite, zweites Radius Rohrbogen (rb), drittes halber  ;Rohrdurchmesser (rr)

        ((15 25 21.3)
  (20 28.5 26.9)
          (25 38 33.7)
          (32 47.5 42.4)
          (40 57 48.3)
          (50 76 60.3)
          (65 95 76.1)
          (80 114.5 88.9)
          (100 152.5 114.3)         
(125 190.5 139.7)
          (150 228.5 168.3)
          (175 270 193.7)
          (200 305 219.1)
          (250 381 273)
          (300 457 323.9)
          (350 533.5 355.6)
          (400 609.5 406.4)
          (500 762 508)
          (600 900 610)
          (700 1050 711)
          (800 1200 813)
          (900 1350 914)
          (1000 1500 1016)
          (1200 1800 1220)
        ))
        (setq rb (cadr (assoc dn liste)))
(setq rr (caddr (assoc dn liste)))
          (if (= nw nil)  (progn
        (princ  "\nNennweite nicht vorhanden : ")
        );end progn
        );end if

Falls mir  jemand helfen kann die Routine nach obiger Beschreibung hier fortzusetzen, schon jetzt recht herzlichen Dank
Hans

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

Brischke
Moderator
CAD on demand GmbH




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

Beiträge: 4136
Registriert: 17.05.2001

AutoCAD 20XX, defun-tools (d-tools.eu)

erstellt am: 09. Apr. 2005 21:07    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 HANS at Stmk 10 Unities + Antwort hilfreich

Hallo Hans,

ich habe das mal schnell runter getippt und auch ein wenig dokumentiert.

Aber in diesen Zeilen fehlen alle Dinge (Objektfänge, Elementprüfung, Errorhandling), die notwendig sind, damit das Programm immer Sauber arbeitet, bzw sauber aussteigt (bei fehlerhaften Benutzereingaben)!! So kannst du es nur zum Erkennen des Weges nutzen.

Bei Fragen ...

Grüße Holger

Code:
(vl-load-com)
(setq rbDATA
      '(
(100 . (152.5 114.3))
;...
)
      )
(defun c:rb (/ l1 l2 nw nw daten rad rr
    bogMitte bog1 bog2 offsetpt1 offsetpt2
    l1pt1 l1pt2 l2pt1 l2pt2)
  ;Daten ermitteln
  (setq l1 (car (entsel "\nErste Linie:"));Linie 1
l2 (car (entsel "\nZweite Linie:"));Linie 2
)
  (initget 1)
  (setq nw (getint "\nNennweite: ");Nennweite abfragen
daten (cdr (assoc nw rbDATA));Daten aus Liste ermitteln
rad (car daten);Radius
rr (cadr daten);Halber Abstand
)
  ;
  ;Sysvars für Abrunderadius und Versetztabstand setzen
  (setvar "FILLETRAD" rad)
  (setvar "OFFSETDIST" rr)
  ;bei Befehl versetzen die Seite angeben
  ;- dafür kann der Schnittpunkt der beiden Linien genommen werden
  (setq offsetpt1
(vlax-safearray->list
  (vlax-variant-value
    (vlax-invoke-method
      (vlax-ename->vla-object l1)
      'IntersectWith
      (vlax-ename->vla-object l2)
      acExtendBoth)
    )
  )
)
  ;Linien abrunden
  (command "_.FILLET" l1 l2)
  ;zuletzt erzeugtes Element ist der Bogen
  (setq bogMitte (entlast))
  ;bei Befehl versetzen die Seite angeben
  ;- dafür kann der Zentrumspunkt des Bogens genommen werden
  (setq offsetpt2 (vlax-safearray->list
    (vlax-variant-value(vlax-get-property
(vlax-ename->vla-object bogMitte)
'Center
)
      )
    )
)
  ;Versetzen auf die eine Seite
  (command "_.offset" "" bogMitte offsetpt1 "")
  ;zuletzt erzeugtes Element ist der versetzte Bogen
  ;diesen ermitteln, damit die Punkte ermittelt werden können für die Verbindungslinien
  (setq bog1 (entlast))
  ;Versetzen auf die andere Seite
  (command "_.offset" "" bogMitte offsetpt2 "")
  ;zuletzt erzeugtes Element ist der versetzte Bogen
  ;diesen ermitteln, damit die Punkte ermittelt werden können für die Verbindungslinien
  (setq bog2 (entlast))
  ;Linienpunkte ermitteln
  ;da die Versetztbögen gleiche Richtung haben, wie der Ursprungsbogen, kann auf die
  ;Prüfung der zueinander passenden Punkte verzichtet werden
  ;EndPT - EndPT - StartPT StartPT
  (setq l1pt1 (vlax-curve-getStartPoint
(vlax-ename->vla-object bog1)
)
l1pt2 (vlax-curve-getStartPoint
(vlax-ename->vla-object bog2)
)
l2pt1 (vlax-curve-getEndPoint
(vlax-ename->vla-object bog1)
)
l2pt2 (vlax-curve-getEndPoint
(vlax-ename->vla-object bog2)
)
)
  ;Linien zeichnen
  (command "_.LINE" l1pt1 l1pt2 "")
  (command "_.LINE" l2pt1 l2pt2 "")
  ;fertig
  (princ)
  )

------------------
Holger Brischke
CAD on demand GmbH                              Autodesk User Group Central Europe
Individuelle Lösungen von Heute auf Morgen.              AUGCE Manager Deutschland

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

HANS at Stmk
Mitglied
Techniker

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

Beiträge: 4
Registriert: 09.04.2005

erstellt am: 10. Apr. 2005 14:47    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 Holger,
herzlichen Dank für Deine Hilfe. Habe die Routine schon getestet. Einige Anpassungen für meinen Gebrauch habe ich dazugeschrieben:
In meiner Zeichnung habe ich für verschiedene Medienrohre verschiedene Layer wie z.B. pipe_hydro, pipe_gypsum usw. Die Layer haben verschiedene Farben, Ltyp haben alle „continous“. Auf jedem Layer sind die Rohr-Aussenkanten mit Farbe „vonlayer“ und Ltyp „vonlayer“, die Rohrmitten aber mit Farbe „1“ und Ltyp „mitte“ gezeichnet. So wie es jetzt unten steht, funktioniert es für meinen Bedarf bestens. Es gibt aber noch keine Meldung, wenn man versucht zwei Rohrmitten abzurunden, die auf verschiedenen Medienlayern sind, damit kann ich aber leben. Elementprüfung, Errorhandling usw. einfügen ist für mich als Anfänger noch zu hoch gegriffen.
(vl-load-com)
(setq rbDATA
      '(
(15 . (25 10.65))
(20 . (28.5 13.45))
(25 . (38 16.85))
(32 . (47.5 21.2))
(40 . (57 24.15))
(50 . (76 30.15))
(65 . (95 38.05))
(80 . (114.5 44.45))
(100 . (152.5 57.15))
(125 . (190.5 69.85))
(150 . (228.5 84.15))
(175 . (270 96.85))
(200 . (305 109.55))
(250 . (381 136.5))
(300 . (457 161.95))
(350 . (533.5 177.8))
(400 . (609.5 203.2))
(500 . (762 254))
(600 . (900 305))
(700 . (1050 355.5))
(800 . (1200 406.5))
(900 . (1350 457))
(1000 . (1500 508))
(1200 . (1800 610))
;.....
)
      )
(defun c:rb (/ l1 l2 nw nw daten rad rr
    bogMitte bog1 bog2 offsetpt1 offsetpt2
    l1pt1 l1pt2 l2pt1 l2pt2)
  ;Daten ermitteln
  (setq l1 (car (entsel "\nErste Linie:"));Linie 1
l2 (car (entsel "\nZweite Linie:"));Linie 2
)
  (initget 1)
  (setq nw (getint "\nNennweite: ");Nennweite abfragen
daten (cdr (assoc nw rbDATA));Daten aus Liste ermitteln
rad (car daten);Radius
rr (cadr daten);Halber Abstand
)
  ;
  ;Sysvars für Abrunderadius und Versetztabstand setzen
  (setvar "FILLETRAD" rad)
  (setvar "OFFSETDIST" rr)
  ;bei Befehl versetzen die Seite angeben
  ;- dafür kann der Schnittpunkt der beiden Linien genommen werden
  (setq offsetpt1
(vlax-safearray->list
  (vlax-variant-value
    (vlax-invoke-method
      (vlax-ename->vla-object l1)
      'IntersectWith
      (vlax-ename->vla-object l2)
      acExtendBoth)
    )
  )
)
  ;Linien abrunden
  (command "_.FILLET" l1 l2)
  ;zuletzt erzeugtes Element ist der Bogen
  (setq bogMitte (entlast))
  ;bei Befehl versetzen die Seite angeben
  ;- dafür kann der Zentrumspunkt des Bogens genommen werden
  (setq offsetpt2 (vlax-safearray->list
    (vlax-variant-value(vlax-get-property
(vlax-ename->vla-object bogMitte)
'Center
)
      )
    )
)
  ;Versetzen auf die eine Seite
  (command "_.offset" "" bogMitte offsetpt1 "")
  ;zuletzt erzeugtes Element ist der versetzte Bogen
  ;diesen ermitteln, damit die Punkte ermittelt werden können für die Verbindungslinien
  (setq bog1 (entlast))
  (command "_change" bog1 "" "ei" "f" "vonlayer" "")
  (command "_change" bog1 "" "ei" "lty" "vonlayer" "")
  ;Versetzen auf die andere Seite
  (command "_.offset" "" bogMitte offsetpt2 "")
  ;zuletzt erzeugtes Element ist der versetzte Bogen
  ;diesen ermitteln, damit die Punkte ermittelt werden können für die Verbindungslinien
  (setq bog2 (entlast))
  (command "_change" bog2 "" "ei" "f" "vonlayer" "")
  (command "_change" bog2 "" "ei" "lty" "vonlayer" "")
  ;Linienpunkte ermitteln
  ;da die Versetztbögen gleiche Richtung haben, wie der Ursprungsbogen, kann auf die
  ;Prüfung der zueinander passenden Punkte verzichtet werden
  ;EndPT - EndPT - StartPT StartPT
  (setq l1pt1 (vlax-curve-getStartPoint
(vlax-ename->vla-object bog1)
)
l1pt2 (vlax-curve-getStartPoint
(vlax-ename->vla-object bog2)
)
l2pt1 (vlax-curve-getEndPoint
(vlax-ename->vla-object bog1)
)
l2pt2 (vlax-curve-getEndPoint
(vlax-ename->vla-object bog2)
)
)
  ;Linien zeichnen
  (command "_.LINE" l1pt1 l1pt2 "")
  (command "_matchprop" bog1 "l" "")
  (command "_.LINE" l2pt1 l2pt2 "")
  (command "_matchprop" bog1 "l" "")
  ;fertig
  (princ)
  )
___________________________________________________


Ausserdem habe ich noch was einfaches gemacht um ein Rohr zu zeichnen. Es funktioniert, aber es kommt zum Abschluss immer die Meldung:  R Unbekannter Befehl "R".
Was muß ich unten noch dazuschreiben, damit bei eingeschaltetem Ortho das Rohr nur orthogonal gezeichnet werden kann? Es wäre auch noch schön, wenn nach anklicken des ersten Punktes dem Curser ein Gummiband folgt (wie z. B. beim Befehl "Linie")


(defun c:R ()
(setq colold (getvar "cecolor"))
(setq ltold (getvar "celtype"))
(setq lay (getvar "clayer"))
(setq dn (getint "\nNennweite eingeben : "))
        (setq liste '
        ((15 25 21.3) (20 28.5 26.9)
          (25 38 33.7)
          (32 47.5 42.4)
          (40 57 48.3)
          (50 76 60.3)
          (65 95 76.1)
          (80 114.5 88.9)
          (100 152.5 114.3)
          (125 190.5 139.7)
          (150 228.5 168.3)
          (175 270 193.7)
          (200 305 219.1)
          (250 381 273)
          (300 457 323.9)
          (350 533.5 355.6)
          (400 609.5 406.4)
          (500 762 508)
          (600 900 610)
          (700 1050 711)
          (800 1200 813)
          (900 1350 914)
          (1000 1500 1016)
          (1200 1800 1220)
        ))
        (setq nw (caddr (assoc dn liste)))
          (if (= nw nil)  (progn
        (princ  "\nNennweite nicht vorhanden : ")
        );end progn
        );end if
(setq p1 (getpoint "\Startpunkt: "))
(setq p2 (getpoint "\Endpunkt: "))
(command "_color" "1")
(command "_linetype" "s" "mitte" "")
(command "_LINE" p1 p2 "")
(setvar "cecolor" colold)
(setvar "celtype" ltold)
(command "_mline" "a" "n" "m" nw p1 p2 "")
(command "_explode" "l" "")
(redraw)
(princ)
);end defun


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

otterloh
Mitglied



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

Beiträge: 183
Registriert: 27.06.2001

AutoCAD 2008, 2010
Vista, Win7

erstellt am: 10. Apr. 2005 17: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 HANS at Stmk 10 Unities + Antwort hilfreich

Hallo Hans,
ändere mal diese Zeilen, dann gehts.

(setq p1 (getpoint "\nStartpunkt: "))
(setq p2 (getpoint p1 "\nEndpunkt: "))
.
.
.
(command "_explode" "l" )

------------------
Gruß Werner
http://www.konstruktionsbuero-meyer.de

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