;*************************************************;
; BY ;
; MANUEL CARRIZALES ;
;*************************************************;
;;error handling
(defun *lay_error* (msg)
(if (/= msg "Function cancelled")
(if (= msg "quit / exit abort")
(princ)
(princ (strcat "\nError: " msg))
)
)
(setq *error* *old_error* *old_error* nil)
(princ)
)
(defun c:lp (/ num nesting pik end counter lay str_lay_lst str lay_lst check dcl_id clr f b line_type ltlst lt1 chk_lst already_in_lst check t)
(setvar "cmdecho" 1)
(setq num (load_dialog "lp"))
(new_dialog "lpa" num)
(set_tile "but1" "1")
(action_tile "accept" "(do_setins)(done_dialog)")
(action_tile "cancel" "(do_exit)")
(start_dialog)
(done_dialog)
(if (= nesting "1")
(do_step2)
(if end
(progn
(princ)
(princ end)
(princ)
)
(do_step3)
)
)
)
(defun do_exit ()(setq end "Thank you."))
(defun do_setins ()
(setq nesting (get_tile "but1"))
)
(defun do_step2 ()
(setq pik 1)
(setq counter 0)
(while pik
(setq pik (nentsel "\nSelect entity\(s\) on desired layers to modify <nesting is on>: "))
(if (/= pik nil)
(progn
(setq counter (+ 1 counter))
(setq lay (assoc 8 (entget (car pik))))
(setq str (cdr lay))
(princ str)
(if (= str_lay_lst nil)
(setq str_lay_lst (strcat (cdr (assoc 8 (entget (car pik))))))
(progn
(setq str_lay_lst (strcat (cdr (assoc 8 (entget (car pik)))) "," str_lay_lst))
(setq chk_lst (cdr (assoc 8 (entget (car pik)))))
(mapcar (quote (lambda (x) (if (= x chk_lst)(setq already_in_lst 1)))) lay_lst)
)
)
(if already_in_lst
(progn
(setq already_in_lst nil)
(alert "You already picked this layer!")
)
(setq lay_lst (cons (cdr (assoc 8 (entget (car pik)))) lay_lst))
)
)
(progn
(if (= str_lay_lst nil)
(progn
(alert "You missed! Try again.")
(do_step2)
)
(progn
(setq lay_lst (acad_strlsort lay_lst))
(do_laydlg_n)
)
)
)
)
)
)
(defun do_step3 ()
(setq pik 1)
(setq counter 0)
(while pik
(setq pik (entsel "\nSelect entity\(s\) on desired layers to modify: "))
(if (/= pik nil)
(progn
(setq counter (+ 1 counter))
(setq lay (assoc 8 (entget (car pik))))
(setq str (cdr lay))
(princ str)
(if (= str_lay_lst nil)
(setq str_lay_lst (strcat (cdr (assoc 8 (entget (car pik))))))
(progn
(setq str_lay_lst (strcat (cdr (assoc 8 (entget (car pik)))) "," str_lay_lst))
(setq chk_lst (cdr (assoc 8 (entget (car pik)))))
(mapcar (quote (lambda (x) (if (= x chk_lst)(setq already_in_lst 1)))) lay_lst)
)
)
(if already_in_lst
(progn
(setq already_in_lst nil)
(alert "You already picked this layer!")
)
(setq lay_lst (cons (cdr (assoc 8 (entget (car pik)))) lay_lst))
)
)
(progn
(if (= str_lay_lst nil)
(progn
(alert "You missed! Try again.")
(do_step3)
(princ)
)
(progn
(setq lay_lst (acad_strlsort lay_lst))
(do_laydlg)
)
)
)
)
)
)
******************************************************************************************
;;;---------------------SET LAYER LIST-------------------------
(defun do_laylist ()
(start_list "laylst")
(mapcar ' add_list lay_lst)
(end_list)
)
(defun do_laylist_n ()
(start_list "laylst_n")
(mapcar ' add_list lay_lst)
(end_list)
)
*******************************************************************************************
(defun do_clr ()
(if (= clr 0)
(progn
(alert "BYBLOCK is not a color! Try again.")
(do_colors)
(do_clr)
)
(progn
(if (= clr 256)
(progn
(alert "BYLAYER is not a color! Try again.")
(do_colors)
(do_clr)
)
(progn
(command "layer" "c" clr str_lay_lst "")
(setq check "Thank you.")
)
)
)
)
)
(defun do_lt ()(command "layer" "lt" lt1 str_lay_lst "")(command "regen")(setq check "Thank you."))
*******************************************************************************************
;;;---------------------DIALOG BOX FUNCTION------------------------------
(defun do_laydlg () ;;;LOADS DIALOGUE BOX
(setq dcl_id (load_dialog "lp.dcl"))
(new_dialog "lpb" dcl_id)
(do_laylist) ;;;LOAD LAYER LIST
(action_tile "color1" "(do_colors)")
(action_tile "lt1" "(do_ltype)")
(action_tile "accept" "(do_getent)(done_dialog)")
(action_tile "cancel" "(setq clr nil)(setq lt1 nil)(do_exit)")
(start_dialog) ;;;DISPLAY DIALOG BOX
(unload_dialog dcl_id)
(if clr (do_clr))
(if lt1 (do_lt)) ;;;UNLOAD DCL FILE
(if end
(progn
(princ)
(princ end)
(princ)
)
)
)
(defun do_laydlg_n ()
(setq dcl_id (load_dialog "lp.dcl"))
(new_dialog "lpc" dcl_id)
(do_laylist_n) ;;;LOAD LAYER LIST
(action_tile "color1" "(do_colors)")
(action_tile "lt1" "(do_ltype)")
(action_tile "accept" "(done_dialog)")
(action_tile "cancel" "(setq clr nil)(setq lt1 nil)(do_exit)")
(start_dialog)
(unload_dialog dcl_id)
(if clr (do_clr))
(if lt1 (do_lt))
(if end
(progn
(princ)
(princ end)
(princ)
)
)
)
;;;---------------------COLOR WHEEL------------------------------
(defun do_colors ()
(setq clr (acad_colordlg 1))
)
(defun do_getent ()(setq check "Thank you."))
**********************************************************************************************
;;;---------------------SET LINETYPE LIST-------------------------
(defun set_ltlist ()
(setq f 1)
(while (setq t (tblnext "ltype" f))
(setq f nil)
(setq b (assoc 2 t))
(setq line_type (cdr b))
(if (not (wcmatch line_type "*|*"))
(setq ltlst (cons (cdr (assoc 2 t)) ltlst))
)
)
(setq ltlst (acad_strlsort ltlst))
)
;;;---------------------LTYPE DIALOG BOX FUNCTION------------------------------
(defun do_ltype () ;;;LOADS DIALOGUE BOX
(setq dcl_id (load_dialog "lp.dcl"))
(new_dialog "lpd" dcl_id)
(set_ltlist)
(start_list "ltype_list")
(mapcar ' add_list ltlst)
(end_list)
(action_tile "ltype_list" "(setq lt1 (nth (atoi $value) ltlst))")
(action_tile "accept" "(done_dialog)")
(action_tile "cancel" "(setq lt1 nil)")
(start_dialog) ;;;DISPLAY DIALOG BOX
(unload_dialog dcl_id) ;;;UNLOAD DCL FILE
)
**********************************************************************************************