;|
Funktion zum Zerschneiden/Exploden einer Linie zu Ihrem Aussehen gemäß Linientyp
Version: 1.0
Status: läuft
Autor: Henning Jesse, VoxelManufaktur
|;
(setq vox:honor_delobj nil)
(defun c:xll () (c:explode-line2linetype))

(defun c:explode-line2linetype (/ alt_os alt_la alt_lt alt_ls alt_co ss ele scal lty eig scal2 lg0 p0 pe lg l w r f n longer counter lines)
  (setvar "cmdecho" 0)
  (command "_undo" "_begin")
  (setq alt_os (getvar "osmode")) (setvar "osmode" 0)
  (setq alt_la (getvar "clayer"))
  (setq alt_co (getvar "cecolor"))(setvar "cecolor" "ByLayer")
  (setq alt_lt (getvar "celtype"))(setvar "celtype" "ByLayer")
  (setq alt_ls (getvar "celtscale"))(setvar "celtscale" 1)
  (setq ss (ssget '((0 . "LINE"))) z -1)
  (setq scal (getvar "ltscale"));globaler Skalierfaktor
  (setq lines 0)
  (if ss
    (while (setq ele (ssname ss (setq z (1+ z))))
      (or
        (setq lty (cdr (assoc 6 (setq eig (entget ele)))));Element Linientyp (fest) (GC 6)
        (setq lty (cdr (assoc 6 (tblsearch "layer" (cdr (assoc 8 eig)))))); Layer Linientyp (vonLayer)
      )
      (if (setq scal2 (cdr (assoc 48 eig))) (setq scal (* scal scal2))); Element-Linietyp-Skalierung vorhanden (GC 48)
      (setq lty (tblsearch "ltype" lty));Eigenschaften des Linintyps
      (setq lg0 (cdr (assoc 40 lty))); Gesamtlänge eines Musters
      (setq lty (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 49)) lty))); Musterdaten (GC 49)
      (if lty ;Musterdaten vorhanden (nicht "continous")
        (progn
          (if (not (tblsearch "layer" (setq lay_nam (strcat (cdr (assoc 8 eig)) "-exploded")))); Layer erzeugen / setzen
            (entmake
              (list
                (cons 0 "LAYER")
	        (cons 100 "AcDbSymbolTableRecord")
	        (cons 100 "AcDbLayerTableRecord")
	        (cons 2 lay_nam)
	        (cons 70 0)
	        (assoc 62 (tblsearch "layer" (cdr (assoc 8 eig))))
              )
            )
          )
          (setvar "clayer" lay_nam)
          (setq p0 (cdr (assoc 10 eig)) pe (cdr (assoc 11 eig)) lg (distance p0 pe) w (angle p0 pe) longer nil);Startpunkt, Endpunkt, Länge, Winkel der Linie
  ;;;        (command "_point" p0)
  ;;;        (command "_point" pe)
          (setq r (fix (/ lg (* lg0 scal))));Anzahl der Muster
          (setq f (- lg (* r lg0 scal))); Restlänge, die kein komplettes Muster mehr hat
          (setq l (+ (/ (- (* scal (setq a (car lty))) f) 2) f)); Verteilung der Restlänge
          (if (> f (* scal a)) (setq longer t));longer = t -> Startlinie wird verlängert
          (entmake (list (cons 0 "LINE") (cons 10 p0) (cons 11 (setq p0 (polar p0 w l)))));erster (verkürzter / verlängerter) Linienapschnitt
          (setq lines (1+ lines))
          (setq lty (append (cdr lty) (list a)) counter 0); Musterdaten anpassen
          (repeat r;restliche Muster zeichnen
            (setq counter (1+ counter))
            (foreach n lty
              (if (< n 0)
                (progn
                  (setq p0 (polar p0 w (* scal (abs n))) l (+ l (* scal (abs n))))
                )
                (progn
                  (setq p1 (polar p0 w (* scal n)) l (+ l (* scal n)))
                  (if (< l lg)
                    (progn
                      (if (and longer (= counter r))
                        (entmake (list (cons 0 "LINE") (cons 10 p0) (cons 11 pe)))
                        (entmake (list (cons 0 "LINE") (cons 10 p0) (cons 11 p1)))
;;;                        (command "_line" p0 pe "")
;;;                        (command "_line" p0 p1 "")
                      )
                      (setq lines (1+ lines))
                      (setq p0 p1)
                    )
                    (progn
                      (entmake (list (cons 0 "LINE") (cons 10 p0) (cons 11 pe)))
;;;                      (command "_line" p0 pe "")
                      (setq lines (1+ lines))
                    )
                  )
                )
              )
            )
          )
          (if (and (= (getvar "delobj") 1) vox:honor_delobj) (entdel ele))
        )
      )
    )
  )
  (setvar "clayer" alt_la)
  (setvar "celtscale" alt_ls)
  (setvar "cecolor" alt_co)
  (setvar "celtype" alt_lt)
  (setvar "osmode" alt_os)
  (command "_undo" "_end")
  (setvar "cmdecho" 1)
  (prompt (strcat (itoa lines) " Linien erstellt!"))(prin1)
)