;Flaschenpost (cad.de) 19.03.05 
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Füllen von P-linien in Blöcken (flache Volumen-Körper)
;
(defun c:BPV (/ aktcol zm zf blwahl blname gm
            subel_list x y n nr asatz lwp reg)

(setq aktcol (getvar "CECOLOR"))
(setq zm (getvar "VIEWCTR") zf (getvar "VIEWSIZE"))
(prompt "\nBlöcke wählen: ")
(setq blwahl (ssget '((0 . "INSERT"))))
(setq nr 0)
(setq gm (getvar "GRIDMODE"))
(setvar "GRIDMODE" 0)

(repeat (sslength blwahl)
(setq blname (ssname blwahl nr))
(setq blname (cdr (assoc 2 (entget blname))))
(setq x (cdr (assoc -2 (tblsearch "BLOCK" blname))))
(setq subel_list nil)
(setq subel_list (cons x subel_list))
(while  (entnext x)
        (setq y (cdr (assoc -1 (entget (entnext x)))))
        (setq subel_list (cons y subel_list))
        (setq x y)
)  
(setq n 0)
(setq asatz (ssadd))
(repeat (length subel_list)
(entmake (entget (nth n subel_list)))
(command "_.zoom" "_A")
(setvar "CECOLOR" "BYBLOCK")
(setq asatz (ssadd (entlast) asatz))
(if (eq (cdr (assoc 0 (entget (entlast)))) "LWPOLYLINE")
    (progn
    (setq lwp (entget (entlast)))
    (print lwp)
    (command "_.ucs" "_OB" "L")
    (command "_extrude" "L" "" "1e-5" "")
    (command "_.ucs" "_P")
    (setq reg (entget (entlast)))
    (print reg)
    (setq reg (subst (assoc 8 lwp)(assoc 8 reg) reg)) 
    (setq reg (subst '(6 . "ByBlock")(assoc 6 reg) reg)) 
    (entmod reg)
    (setq asatz (ssadd (entlast) asatz))
    )
)
(setq n (1+ n))
)
(command "_.-block" blname "J" "0,0" asatz "")
(setq nr (1+ nr))
);repeat
(setvar "CECOLOR" aktcol)
(setvar "GRIDMODE" gm)
(command "_.zoom" "_C" zm zf)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Füllen von P-linien in Blöcken (Regionen)
;START mit BPR
;
;

(defun c:BPR (/ aktcol zm zf blwahl blname gm
            subel_list x y n nr asatz lwp reg)
(setq aktcol (getvar "CECOLOR"))
(setq zm (getvar "VIEWCTR") zf (getvar "VIEWSIZE"))
(prompt "\nBlöcke wählen: ")
(setq blwahl (ssget '((0 . "INSERT"))))
(setq nr 0)
(setq gm (getvar "GRIDMODE"))
(setvar "GRIDMODE" 0)
(repeat (sslength blwahl)
(setq blname (ssname blwahl nr))
(setq blname (cdr (assoc 2 (entget blname))))
(setq x (cdr (assoc -2 (tblsearch "BLOCK" blname))))
(setq subel_list nil)
(setq subel_list (cons x subel_list))
(while  (entnext x)
        (setq y (cdr (assoc -1 (entget (entnext x)))))
        (setq subel_list (cons y subel_list))
        (setq x y)
)  
(setq n 0)
(setq asatz (ssadd))
(repeat (length subel_list)
(entmake (entget (nth n subel_list)))
(command "_.zoom" "_A")
(setvar "CECOLOR" "BYBLOCK")
(setq asatz (ssadd (entlast) asatz))
(if (eq (cdr (assoc 0 (entget (entlast)))) "LWPOLYLINE")
    (progn
    (setq lwp (entget (entlast)))
    (print lwp)
    (command "_.ucs" "_OB" "L")
    (command "_.region" "L" "")
    (command "_.ucs" "_P")
    (setq reg (entget (entlast)))
    (print reg)
    (setq reg (subst (assoc 8 lwp)(assoc 8 reg) reg)) 
    (setq reg (subst '(6 . "ByBlock")(assoc 6 reg) reg)) 
    (entmod reg)
    (setq asatz (ssadd (entlast) asatz))
    )
)
(setq n (1+ n))
)
(command "_.-block" blname "J" "0,0" asatz "")
(setq nr (1+ nr))
);repeat
(setvar "CECOLOR" aktcol)
(setvar "GRIDMODE" gm)
(command "_.zoom" "_C" zm zf)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(print "Programm 'Block-PL-Fuell' geladen, Start mit BPV oder BPR")
(princ)