(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 "\nEinfgepunkt 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 fr 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)
