92 lines
11 KiB
Common Lisp
92 lines
11 KiB
Common Lisp
(setvar "cmdecho" 0)(prompt "\nHauptmen� .. DIN-Koord.Bemassung ")(DEFUN C:G-ASSO ( / s1 s2 ct e1 el e0 a1 p1 e2
|
|
a2 et ta i tx ea)(g_sv)(if (/= (getvar "handles") 1) (progn (prompt "\nReferenzen nicht aktiviert Abbruch")(quit)))(setq s1 (ssget) ct 0
|
|
g-as (g_in g-as "Masstext automatisch vorgeben (Ja=0/Nein=1):" "0"))(if (= s1 nil)(prompt "\nkein Objekt gefunden")(progn(setq e1 (ssname S1 0))
|
|
(prompt "\nObjekte:")(while (/= e1 nil) (setq el (entget e1))(cond((or (/= (cdr (assoc 0 el)) "INSERT") (and (/= (cdr (assoc 2 el)) "DIN358")
|
|
(/= (cdr (assoc 2 el)) "DIN357"))) ())((= nil (handent (setq a1 (cdr (assoc 1 (entget (setq e0 (entnext e1))))))
|
|
))(prompt "\nReferenz Masspfeil fehlt!"))((= (setq ea (entget (handent a1))) nil)(prompt "\nReferenz Masspfeil fehlt!"))
|
|
((/= "INSERT" (cdr (assoc 0 ea)))(prompt "\n Error: Referenz ist kein Pfeil"))((and (/= (setq blonam (cdr (assoc 2 ea)))
|
|
"DIN356")(/= blonam "DIN357")(/= blonam "DIN358")) (prompt "\n Error: Referenz ist kein Pfeil"))((= nil (handent
|
|
(setq a2 (cdr (assoc 1 (entget (entnext e0))))) ))(prompt "\n Referenz Masstext fehlt!"))((= (setq et (entget (handent a2)))
|
|
nil)(prompt "\n Referenz Masstext fehlt!"))((/= "TEXT" (cdr (assoc 0 et)))(prompt "\n Error: Referenz ist kein Text"))(progn
|
|
(setq p1 (trans (cdr (assoc 10 ea)) 0 1) p2 (trans (cdr (assoc 10 el)) 0 1) ta (cdr (assoc 1 et))
|
|
ab (* (distance p1 p2)(cos (- (angle p1 p2)(cdr (assoc 50 el))))))(setq tex (g-teko ab))
|
|
(if (= (chr 237) (substr ta 1 1))(setq tex (strcat (chr 237) tex)))(setq tx tex)(if (/= g-as "0")(progn (command "WAHL" (handent a2))
|
|
(setq tx (g_in tx (strcat "\nBemassungs-Text [Alt " ta "]:") "") I (SEARC "<>" tx)) (if (> i 1)(setq i (- i 1)))
|
|
(if (> i 0)(setq tex (strcat (substr tx 1 i) tex))(setq tex tx)) (command ""))) (entmod (subst (cons 1 tx)(assoc 1 et) et))
|
|
(setq s2 (ssdel (cdr (assoc -1 ea)) s1 )) (if (/= s2 nil)(setq s1 s2))))(prompt (strcat " " (itoa ct)))(setq e1 (ssname S1 (setq ct (1+ ct)))))))
|
|
(setq s1 nil s2 nil)(princ))(prompt ".")(DEFUN C:g-mcz ( / s1 th tp ct el )(g_sv)(setq s1 nil s1 (ssget))
|
|
(if (= s1 nil)(prompt "\nkein Objekt gefunden")(progn(setq massan-1 (g_in massan-1 "\nVer„nderungsfaktor:" 1.0))(setq ct -1)(prompt "\nObjekte:")
|
|
(repeat (sslength S1) (setq el (entget (ssname S1 (setq ct (1+ ct))))) (cond ((= (cdr (assoc 0 el)) "TEXT") (progn
|
|
(setq th (* massan-1 (cdr (assoc 40 el)))) (entmod (subst (cons 40 TH)(assoc 40 el) el))) ) ( (and (= (cdr (assoc 0 el)) "INSERT")
|
|
(OR (= (cdr (assoc 2 el)) "DIN359")(= (cdr (assoc 2 el)) "DIN358") (= (cdr (assoc 2 el)) "DIN357")(= (cdr (assoc 2 el)) "DIN356"))) (progn
|
|
(setq el (subst (cons 41 (* (cdr (assoc 41 el)) massan-1))(assoc 41 el) el))
|
|
(entmod (subst (cons 42 (* (cdr (assoc 42 el)) massan-1))(assoc 42 el) el)) )))(prompt (strcat " " (itoa ct))))))(princ))(prompt ".")
|
|
(DEFUN g-TEKO ( ab / tex du df fa) (setq du (atoi (rtos g_l 2 0)) df 0)(while (and (< df 0.05)(>= du (getvar "LUPREC")))
|
|
(setq fa (* (abs ab) g_g (expt 10.0 (- du 1))) df (abs (- fa (fix (+ fa 0.5)))) du (- du 1)))
|
|
(setq tex (rtos (abs (* ab g_g)) (getvar "LUNITS") (+ du 1) )))(prompt ".")(DEFUN c:SCHNIT ( / p0 p1)(g_sv)
|
|
(setq p0 (getpoint "\nStartpunkt der Schnittlinie / (Ende=Return):") p1 T)
|
|
(if (/= p0 nil)(setq p1 (getpoint p0 "\nN„chster Punkt der Schnittlinie / (Ende=Return):")))(while (/= p1 nil)(command "LINIE" p0 p1 ""
|
|
"ŽNDERN" "L" "" "LA" (nth 11 v-lay))(setq p0 p1)(setq p1 (getpoint p0 "\nN„chster Punkt der Schnittlinie / (Ende=Return):"))))(prompt ".")
|
|
(DEFUN c:PFEIL ( / ot ho br ce p1 p2 p0 tf ag)(g_sv) (setq ho (* 5. g_f) br (* 2.0 g_f) ce (getvar "clayer")) (setvar "orthomode" 1)
|
|
(setq p1 (getpoint "\nEinf�gepunkt des Pfeils / (Ende=Return)")) (if (= p1 nil) (quit))
|
|
(setq p2 (getpoint p1 "\nEndpunkt des Pfeils / (Ende=Return)")) (if (= p2 nil) (quit))
|
|
(setq p0 (getpoint p1 "\nLage der Schnittangabe / (Ende=Return)")) (if (= p0 nil) (quit))
|
|
(setq tf (strcase (g_in tf "\nBuchstabe des Schnittverlaufs:" "A")) ag (angle p1 p2) ) (command "LAYER" "SETZ" (nth 11 v-lay) ""
|
|
"EINFšGE" (strcat pfad "DIN359") p1 br br (angtos ag 0 2) "LINIE" p1 (polar p1 ag (* br 5)) "") (command "TEXT" "M" p0 ho 0 tf)
|
|
(command "LAYER" "SETZ" ce "")(g_un))(DEFUN g-m2 (p0 tx ag sc / p pp e1)(setq *error* g_er p (polar p0 ag (* 2.5 sc)) p (g-m3 p p0 ag sc))
|
|
(while (> ag pi)(setq ag (- ag pi pi)))(while (< ag (- 0 pi))(setq ag (+ ag pi pi)))(setq pp (POLAR P (+ ag (/ PI 4)) (/ sc 1.4142))
|
|
p (POLAR P (- ag (/ PI 4)) (/ sc 1.4142)))(cond((AND (>= ag 0) (<= ag (/ PI 2.))) (COMMAND "TEXT" p sc (ANGTOS ag 0 8) tx))
|
|
((< ag (* (- 0 1)(/ PI 2.))) (COMMAND "TEXT" p sc (ANGTOS ag 0 8) tx))((and (< ag 0) (>= ag (* pi 0.5 (- 0 1))))(COMMAND "TEXT" "R" pp sc
|
|
(ANGTOS (- ag PI) 0 8) tx))((> ag (/ PI 2.)) (COMMAND "TEXT" "R" Pp sc (ANGTOS (- ag PI) 0 8) tx)))(setq e1 (entget (entlast)))
|
|
(entmod (subst (cons 8 (nth 6 v-lay))(assoc 8 e1) e1)))(prompt ".")(defun g-m3 ( p pl ag sc / p1 p0 ot)
|
|
(setq ss (ssget "K" (polar p (+ ag (* pi 0.25)) (* sc)) (polar p (+ ag (* pi 1.25)) (* sc))) p0 p)(if (/= nil ss)(progn
|
|
(setq p (POLAR Pl ag (* g_f (getvar "dimexo")))) (prompt "\nKein Platz f�r Text ! Neue Masslinie: (Return=Weiter)")
|
|
(setq ot (getvar "orthomode"))(setvar "orthomode" 1) (setq p (trans (cdr (assoc 11 (entget (entlast)))) 0 1)) (command "L™SCHEN" "L" "")
|
|
(command "PLINIE" p) (while (/= p nil) (setq p1 p p (getpoint p1 "")) (if (/= p nil)(command p)) ) (command "") (setvar "orthomode" ot)
|
|
(setq p (polar p1 ag (* 1.5 sc)))))(setq p p))(prompt ".")(defun g-m4 (h0 ph pu ag sc ei / p4 p1 dx dy ab a1 i tex tx a4 ht)(if (/= ph nil)(progn
|
|
(setvar "blipmode" 0)(SETVAR "OSMODE" 0) (setq p1 (mapcar '- ph pu) dx (car p1) dy (cadr p1) ab dx a1 dy) (cond ((= 0 ag) (setq ab dy a1 dx))
|
|
((= (rtos pi 2 8) (rtos ag 2 8)) (setq ab dy a1 (- 0 dx))) ((= (rtos ag 2 8)(rtos (- 0 (/ pi 2.)) 2 8)) (setq ab dx a1 (- 0 dy)))
|
|
((= (rtos ag 2 8)(rtos (* pi 1.5) 2 8)) (setq ab dx a1 (- 0 dy))) ) (setq p1 (polar ph ag (+ (* -1 a1) sc )))
|
|
(command "LINIE" p1 (polar ph ag (* g_f (getvar "dimexo"))) "") (SETQ p4 (POLAR P1 (- ag PI) sc))(setq tex (g-teko ab))(if (/= g-m-2 0)(progn
|
|
(setq tx (getstring T (strcat "\nBemassungs-Text:" "<" tex ">"))) (if (= tx "")(setq tx tex)) (setq i (searc "<>" tx)) (if (> i 1)(setq i (- i 1)))
|
|
(if (> i 0)(setq tex (strcat (substr tx 1 i) tex))(setq tex tx)))) (g-m2 p4 tex ag sc)(setq ht (cdr (assoc 5 (entget (entlast)))))
|
|
(setq a4 (angle p4 pu))(if (= (getvar "handles") 0) (COMMAND "EINFšGE" (strcat pfad "din359") p4 g_f g_f (angtos a4))
|
|
(progn (SETVAR "attdia" 0)(command "EINFšGE" (strcat pfad "din357") p4 g_f g_f (angtos a4) h0 ht) (SETVAR "attdia" 1))) (if (= g-m 0)(progn
|
|
(if (= ei nil) (progn(COMMAND "LINIE" p4 pu "") (setq ei (entlast))) (progn (setq pe (trans (cdr (assoc 11 (entget ei))) 0 1)
|
|
pa (trans (cdr (assoc 10 (entget ei))) 0 1)) (cond ((and (equal (angle pa pe) (angle pa p4) 0.00001) (> (distance pa p4)(distance pa pe)))
|
|
(entmod (subst (cons 11 (trans p4 1 0)) (assoc 11 (entget ei))(entget ei)))) ((> (distance pe p4)(distance pa pe))
|
|
(entmod (subst (cons 10 (trans p4 1 0)) (assoc 10 (entget ei))(entget ei)))) )))))))(setq ei ei))(prompt ".")
|
|
(defun g-m5 ( sc tr / pu p ph h1 s1 ee ag ct)(setq pu (GETPOINT tr) )(setvar "ORTHOMODE" 1)(if (= pu nil)(progn(setq ee nil)(while (= ee nil)
|
|
(setq p (getpoint "\nAntippen Nullpunkt:") ee nil s1 (ssget "K" (polar p (* 0.25 pi) (* g_f)) (polar p (* 1.25 pi) (* g_f))) ct 0)
|
|
(if (= s1 nil)(prompt "\nError: Falscher Nullpunkt:")(progn(while (and (/= nil (setq ee (ssname s1 ct))) (or (/= "INSERT" (cdr (assoc 0 (entget ee))))
|
|
(/= (cdr (assoc 2 (entget ee))) "DIN356")))(setq ct (+ ct 1)))(if (= ee nil)(prompt "\nError: Falscher Nullpunkt:")))))
|
|
(setq h1 (cdr (assoc 5 (entget ee))))(g_se))(progn(setq ph (getpoint pu "\nBeginn der Masshilfslinie:"))(g_se)(SETQ ag (ANGLE pu ph)
|
|
l (distance pu ph))(command "EINFšGE" "din356" ph g_f g_f (* (/ ag pi) 180.0))(setq h1 (cdr (assoc 5 (entget (entlast)))))
|
|
(command "LINIE" (polar ph ag sc) (polar pu ag (* g_f (getvar "dimexo"))) "")(g-m2 ph "0" ag sc)))(setq h1 h1))(prompt ".")
|
|
(DEFUN C:MASS ( / p1 p2 p3 p4 ce ag a2 l sc p5 a1)(g_sv)(graphscr)(if (= 0 (getvar "handles"))(progn
|
|
(setq ce (g_in ce "\nAssoziativit„t nicht m”glich : (0=ein/1=ohne/2=Abbruch)" "0"))(cond((= ce "0")(command "REFERENZ" "EIN"))((= ce "1")())((quit))
|
|
)))(setq ce (getvar "clayer") sc (* 3.5 g_f) g-m (g_in g-m "\nMit Masslinie (Ja=0/Nein=1)?" 0)
|
|
g-m-1 (g_in g-m-1 "2-achsige-Bemassung (Ja=0/Nein=1):" 0) g-m-2 (g_in g-m-2 "Masstext automatisch vorgeben (Ja=0/Nein=1):" 0))
|
|
(command "LAYER" "SETZ" (nth 5 v-lay) "")(setq h1 (g-m5 sc "\n1.Nullpunkt setzen/Return=1.Nullpunkt vorhanden:") e1 (entget (handent h1))
|
|
a1 (cdr (assoc 50 e1)) p1 (trans (cdr (assoc 10 e1)) 0 1) )(if (= g-m-1 0)(progn(g_ru)
|
|
(setq ha2 (g-m5 sc "\n2.Nullpunkt setzen/Return=2.Nullpunkt vorhanden:") e2 (entget (handent ha2)) a2 (cdr (assoc 50 e2))
|
|
p2 (trans (cdr (assoc 10 e2)) 0 1) )))(g_se)(setq pl (g-m6))(if (/= nil pl)(progn(setq px (g-m7 p1 pl a1))(setq ei nil)
|
|
(foreach p px (setq ei (g-m4 h1 p p1 a1 sc ei)))(if (= g-m-1 0)(progn (setq py (g-m7 p2 pl a2) ei nil)
|
|
(foreach p py (setq ei (g-m4 ha2 p p2 a2 sc ei)))))))(setq p3 T ei nil ei2 nil)(while (/= p3 nil) (g_ru)
|
|
(SETQ p3 (GETPOINT "\nAusgangspunkt der n„chsten Hilfslinie (Ende=Return):"))(g_se)(setq ei (g-m4 h1 p3 p1 a1 sc ei))
|
|
(if (= g-m-1 0)(setq ei2 (g-m4 ha2 p3 p2 a2 sc ei2))))(command "LAYER" "SETZ" ce "") (princ))(prompt ".")(defun g-m6 ( / ss pl ct el ez la)
|
|
(prompt "\nBemassungsobjekte w„hlen/Return=Einzelauswahl")(prompt "\nNur Layer 0,1,2 werden vermasst")(setq ss (ssget) pl nil)(if (/= nil ss)(progn
|
|
(prompt "\nDoppelte Masspunkte l”schen .....")(setq ct (- (sslength ss) 1))(while (>= ct 0) (setq el (entget (ssname ss ct))
|
|
la (substr (cdr (assoc 8 el)) (strlen (cdr (assoc 8 el))) 1))(cond((and (/= la "0")(/= la "1")(/= la "2")) ())((= (cdr (assoc 0 el)) "LINE")(progn
|
|
(setq pl (g-m6-1 (trans (cdr (assoc 10 el)) 0 1) pl) pl (g-m6-1 (trans (cdr (assoc 11 el)) 0 1) pl))))((= (cdr (assoc 0 el)) "POLYLINE")(progn
|
|
(setq ez (entnext (cdr (assoc -1 el)))) (while (= (cdr (assoc 0 (entget ez))) "VERTEX") (setq pl (g-m6-1 (trans (cdr (assoc 10 (entget ez))) 0 1) pl)
|
|
ez (entnext ez)) )))((= (cdr (assoc 0 el)) "CIRCLE") (setq pl (g-m6-1 (trans (cdr (assoc 10 el)) 0 1) pl))))(setq ct (- ct 1)))))(setq pl pl))
|
|
(defun g-m6-1 (p pl / c2 )(if (/= (type pl) 'LIST)(setq pl nil pl (cons p pl))(progn(setq c2 0)(while (and (<= c2 (- (length pl) 1))
|
|
(= nil (equal (nth c2 pl) p 0.000001)))(progn(setq c2 (+ 1 c2))))(if (>= c2 (length pl))(setq pl (cons p pl)))))(setq pl pl))
|
|
(defun g-m7 (pt pl ag / pm pa i7 ps ok p7 io)(prompt "\nMasspunkt sortieren ....")
|
|
(if (or (equal ag pi 0.000001)(equal ag 0 0.00001))(setq io 1)(setq io 0))(setq ok nil ps nil)
|
|
(setq pa (list -100000.0 -100000.0) pm (list 100000.0 10000.0))(repeat (length pl)(setq i7 -1)(repeat (length pl)(setq i7 (+ i7 1) p7 (nth i7 pl))
|
|
(cond((equal (distance pm p7) 0 0.00001)())((equal (nth io pt) (nth io p7) 0.00001)())((equal (nth io p7) (nth io pa) 0.00001)())
|
|
((equal (nth io pm) (nth io p7) 0.0001) (if (> (distance pt pm) (distance pt p7))(progn (setq pm p7 ok T))))((and (< (nth io pa) (nth io p7))
|
|
(> (nth io pm) (nth io p7))) (setq pm p7 ok T))))(if (= ok T)(setq ps (cons pm ps) pa pm pm (list 100000.0 100000.0) ok nil)))(setq ps ps))(princ)
|
|
|