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
Foren auf CAD.de (alle Foren)
| 
