; ddchlt a gui to change a layer's linetype
; 2007 by Paul Li pli@altoonporter.com
; Modified by Igal Averbugh 2016 (added option for current layer)
;---------------------------------------------------------------------------;
(princ"\n...DDCHLT: Select to Change A Layer's Linetype...")
(defun c:ddc
(/ add-mdash cmdecho col_tile
dcl_id ddchlt_err ddchlt_olderr drawpattern expert
getindex getltype get_lstbox_items
ini_dlg lt-idx ltedit_act ltlist_act ltname ltnmlst lyrname
makeltlists mdashlist menuecho
old-idx push_echo put_echo
regenmode reset-lt test-ok tile_rect vi wrt_dlg
)
; define custom err function
(defun DDCHLT_err (s) ; If an error (such as CTRL-C) occurs
(close(open (strcat (GETVAR"TEMPPREFIX") "DDCHLT.DCL")"w"))
(put_echo)
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
)
(if ddchlt_olderr (setq *error* ddchlt_olderr)) ; Restore old *error* handler
(princ)
)
; push_echo toggles cmdecho+menuecho modes
(defun push_echo ()
(setq cmdecho (getvar"cmdecho"))
(setq menuecho (getvar"menuecho"))
(setq expert (getvar"expert"))
(setq regenmode (getvar"regenmode"))
(setvar"cmdecho"0)
(setvar"menuecho"1)
(setvar"expert"0)
(setvar"regenmode"1)
)
; put_echo toggles cmdecho+menuecho modes back
(defun put_echo ()
(if regenmode(setvar"regenmode"regenmode))(princ)
(if expert (setvar"expert" expert))(princ)
(if menuecho (setvar"menuecho" menuecho))(princ)
(if cmdecho (setvar"cmdecho" cmdecho))(princ)
)
; wrt_dlg creates dialog box on the fly
(defun wrt_dlg (/ fn)
(setq fn (open (strcat (GETVAR"TEMPPREFIX")"DDCHLT.DCL") "w"))
(write-line"dcl_settings : default_dcl_settings { audit_level = 0; }" fn)
(write-line"ddchlt:dialog{" fn)
(write-line "label = \"Select Linetype For Layer:\";"fn)
(write-line " : text {"fn)
(write-line " key = \"lyrname\";"fn)
(write-line " }"fn)
(write-line "image_block; "fn)
(write-line ": list_box {"fn)
(write-line "key = \"list_lt\";"fn)
(write-line "height = 37;" fn)
(write-line "width = 53;" fn)
(write-line "allow_accept = true;"fn)
(write-line "}"fn)
(write-line ": edit_box {"fn)
(write-line "label = \"Linetype:\";"fn)
(write-line "key = \"edit_lt\";"fn)
(write-line "mnemonic = \"L\";"fn)
(write-line "edit_limit = 217;"fn)
(write-line "allow_accept = false;"fn)
(write-line "}"fn)
(write-line ": row {"fn)
(write-line "fixed_width = true; "fn)
(write-line "alignment = centered; "fn)
(write-line "ok_button;"fn)
(write-line ": button {"fn)
(write-line " label = \"Load\";"fn)
(write-line " key = \"load_lt\";"fn)
(write-line " mnemonic = \"d\";"fn)
(write-line "}"fn)
(write-line "cancel_button;"fn)
(write-line "}"fn)
(write-line "errtile; "fn)
(write-line "}"fn)
(write-line"ltp:dialog{" fn)
(write-line "label = \"Select Linetypes to Load:\";"fn)
(write-line ": row {"fn)
(write-line ": button {"fn)
(write-line " label = \"File\";"fn)
(write-line " key = \"file_bt\";"fn)
(write-line "mnemonic = \"F\";"fn)
(write-line "fixed_width = true; "fn)
(write-line "}"fn)
(write-line ": edit_box {"fn)
(write-line "key = \"file_lt\";"fn)
(write-line "width = 43;" fn)
(write-line "edit_limit = 217;"fn)
(write-line "allow_accept = false;"fn)
(write-line "}"fn)
(write-line "}"fn)
(write-line ": list_box {"fn)
(write-line "key = \"ltpe\";"fn)
(write-line "height = 37;" fn)
(write-line "width = 53;" fn)
(write-line "multiple_select=true;" fn)
(write-line "}"fn)
(write-line ": row {"fn)
(write-line "fixed_width = true; "fn)
(write-line "alignment = centered; "fn)
(write-line "ok_button;"fn)
(write-line ": button {"fn)
(write-line " label = \"Select All\";"fn)
(write-line " key = \"sel_all\";"fn)
(write-line " mnemonic = \"t\";"fn)
(write-line "}"fn)
(write-line ": button {"fn)
(write-line " label = \"Clear All\";"fn)
(write-line " key = \"clr_all\";"fn)
(write-line " mnemonic = \"r\";"fn)
(write-line "}"fn)
(write-line "cancel_button;"fn)
(write-line "}"fn)
(write-line "errtile; "fn)
(write-line "}"fn)
(write-line"ltpreload:dialog{" fn)
(write-line "label = \"Reload Linetype:\";"fn)
(write-line" spacer; "fn)
(write-line " : text {"fn)
(write-line " key = \"ltptxt\";"fn)
(write-line " }"fn)
(write-line" spacer; "fn)
(write-line ": row {"fn)
(write-line ": button {"fn)
(write-line " label = \"Yes\";"fn)
(write-line " key = \"yes\";"fn)
(write-line "mnemonic = \"Y\";"fn)
(write-line "fixed_width = true; "fn)
(write-line "}"fn)
(write-line ": button {"fn)
(write-line " label = \"Yes to All\";"fn)
(write-line " key = \"yes_all\";"fn)
(write-line "mnemonic = \"e\";"fn)
(write-line "fixed_width = true; "fn)
(write-line "}"fn)
(write-line ": button {"fn)
(write-line " label = \"No\";"fn)
(write-line " key = \"no\";"fn)
(write-line "mnemonic = \"N\";"fn)
(write-line "fixed_width = true; "fn)
(write-line "}"fn)
(write-line ": button {"fn)
(write-line " label = \"No to All\";"fn)
(write-line " key = \"no_all\";"fn)
(write-line "mnemonic = \"o\";"fn)
(write-line "fixed_width = true; "fn)
(write-line "}"fn)
(write-line "cancel_button;"fn)
(write-line "}"fn)
(write-line "}"fn)
(setq fn(close fn))
)
; clr_dlg unloads and clears dialog file on the fly
(defun clr_dlg ()
(unload_dialog dcl_id)
(close(open (strcat (GETVAR"TEMPPREFIX") "DDCHLT.DCL")"w"))
)
;;
;; Color a tile, draw linetype, and draw a border around it
;;
(defun col_tile (tile color patlist / x y)
(setq x (dimx_tile tile))
(setq y (dimy_tile tile))
(start_image tile)
(fill_image 0 0 x y color)
(if (= color 7)
(progn
(if patlist (drawpattern x (/ y 2) patlist 0))
(tile_rect 0 0 x y 0)
)
(progn
(if patlist (drawpattern x (/ y 2) patlist 7))
(tile_rect 0 0 x y 7)
)
)
(end_image)
)
;;
;; Draw a border around a tile
;;
(defun tile_rect (x1 y1 x2 y2 color)
(setq x2 (- x2 1))
(setq y2 (- y2 1))
(vector_image x1 y1 x2 y1 color)
(vector_image x2 y1 x2 y2 color)
(vector_image x2 y2 x1 y2 color)
(vector_image x1 y2 x1 y1 color)
)
;;
;; Draw the linetype pattern in a tile. Boxlength is the length of the image
;; tile, y2 is the midpoint of the height of the image tile, pattern is a
;; list of numbers that define the linetype, and color is the color of the
;; tile.
;;
(defun drawpattern (boxlength y2 pattern color / x1 x2
patlist dash)
(setq x1 0 x2 0)
(setq patlist pattern)
(setq fx 30)
(if (= patlist "CONT")
(progn
(setq dash boxlength)
(vi)
(setq x1 boxlength)
)
(foreach dash patlist
(if (> (abs dash) 2.5)
(setq fx 2)
)
)
)
(while ( dash 0)
(vi)
)
(T
(if (< (abs dash) 2) (setq dash 2))
(setq x2 (+ x2 (abs dash)))
)
)
(setq patlist (cdr patlist))
(setq x1 x2)
)
(setq patlist pattern)
)
)
)
;;
;; Draw a dash or dot in image tile
;;
(defun vi ()
(setq x2 (+ x2 dash))
(vector_image x1 y2 x2 y2 color)
)
;;
;; Get all the group code 49 values for a linetype and put them in a list
;; (pen-up, pen-down info)
;;
(defun add-mdash (ltlist1 / dashlist assoclist dashsize)
(setq dashlist nil)
(while (setq assoclist (car ltlist1))
(if (= (car assoclist) 49)
(progn
(setq dashsize (cdr assoclist))
(setq dashlist (cons dashsize dashlist))
)
)
(setq ltlist1 (cdr ltlist1))
)
(setq dashlist (reverse dashlist))
)
;;
;; This function makes 2 lists - ltnmlst & mdashlist. Ltnmlst is a list of
;; linetype names read from the symbol table. Mdashlist is list consisting
;; of lists which define the linetype pattern - numbers that indicate dots,
;; dashes, and spaces taken from group code 49. The list corresponds to the
;; order of names in ltnmlst.
;;
(defun makeltlists (/ ltlist ltname)
(setq mdashlist nil)
(setq ltlist (tblnext "LTYPE" T))
(setq ltname (cdr (assoc 2 ltlist)))
(setq ltnmlst (list ltname))
(while (setq ltlist (tblnext "LTYPE"))
(setq ltname (cdr (assoc 2 ltlist)))
(setq ltnmlst (append ltnmlst (list ltname)))
)
(setq ltnmlst (acad_strlsort ltnmlst))
(foreach ltname ltnmlst
(setq ltlist (tblsearch "LTYPE" ltname))
(if (= ltname "CONTINUOUS")
(setq mdashlist (append mdashlist (list "CONT")))
(setq mdashlist
(append mdashlist (list (add-mdash ltlist)))
)
)
)
)
; get_lstbox_items takes the list box returned string of items and extracts the actual index items from list
(defun get_lstbox_items (str-arg lst-arg / char col dlist end string)
(setq end (strlen str-arg)
col 0
dlist '()
)
(while(< col end)
(setq col (1+ col)
char (substr str-arg col 1)
string ""
)
(if(/= char " ")
(progn
(while(and ( (length lst-arg) idx)
(setq ltname (nth idx lst-arg))
(If(not(tblsearch "LTYPE" ltname))
(setq newnotbllst (append newnotbllst (list ltname)))
(setq newyestbllst (append newyestbllst (list ltname)))
) ; if
(setq idx (1+ idx))
) ; while
) ; defun
(defun do_load (lst-arg / idx ltname pik)
(setq idx 0)
(while (> (length lst-arg) idx)
(setq ltname (nth idx lst-arg))
(if (not pik)
(setq pik ltname)
(setq pik (strcat pik "," ltname))
)
(if (> (strlen pik) 250)
(progn
(COMMAND "_Load" pik aec_acadlinfile)
(setq pik nil)
)
)
(setq idx (1+ idx))
) ; while
(if pik
(COMMAND "_Load" pik aec_acadlinfile)
)
) ; defun
(defun do_load_uni (lst-arg idx-arg / idx ltname pik)
(setq idx idx-arg)
(while (> (length lst-arg) idx)
(setq pik (nth idx lst-arg))
(COMMAND "_Load" pik aec_acadlinfile "_Yes")
(setq idx (1+ idx))
) ; while
) ; defun
(do_seplst (get_lstbox_items piklst LTP_LIST))
(COMMAND "_.Linetype")
(do_load newnotbllst)
(setq k 0)
(while (> (length newyestbllst) k)
(IF(new_dialog "ltpreload" dcl_id)
(progn
(setq ltypname (nth k newyestbllst))
(set_tile "ltptxt" (strcat "Linetype " ltypname " is already loaded. Reload it?"))
(action_tile "yes" "(done_dialog 1)")
(action_tile "yes_all""(done_dialog 2)")
(action_tile "no" "(done_dialog 3)")
(action_tile "no_all" "(done_dialog 4)")
(action_tile "cancel" "(done_dialog 0)")
(setq stid (START_DIALOG))
(cond
((= 1 stid)(command"_Load" ltypname aec_acadlinfile "_Yes"))
((= 2 stid)(do_load_uni newyestbllst k)(setq k (length newyestbllst)))
((or(= 0 stid)(= 4 stid))(setq k (length newyestbllst)))
)
) ; progn
) ; if
(setq k (1+ k))
) ; while
(command "")
)
(defun do_file_def ()
(if(not aec_acadlinfile)(setq aec_acadlinfile(findfile"acad.lin")))
)
(defun do_file ()
(setq aec_acadlinfile(getfiled "Select Linetype File" aec_acadlinfile "lin" 8))
(do_file_def)
)
(defun clr_all (alst / i)
(set_tile "ltpe" "")
(set_tile "ltpe" "0")
(set_tile "ltpe" "")
(mode_tile "clr_all" 1)
(mode_tile "clr_all" 4)
(mode_tile "sel_all" 0)
(mode_tile "sel_all" 4)
(mode_tile "accept" 1)
(mode_tile "accept" 4)
(setq piklst nil)
)
(defun sel_all (alst / i str strl)
(setq i 0)
(repeat (length alst)
(if str
(progn
(setq str (strcat str " " (itoa i)))
(cond ((> (strlen str) 250)
(if strl
(setq strl (append strl (list str)))
(setq strl (list str))
)
(setq str nil)
)
)
)
(progn
(setq str (itoa i))
)
)
(setq i (1+ i))
)
(if strl
(progn
(if str (setq strl (append strl (list str))))
(setq i 0)
(repeat (length strl)
(set_tile "ltpe" (nth i strl))
(if (/= i 0)
(setq piklst (strcat piklst " " (nth i strl)))
(setq piklst (nth i strl))
)
(setq i (+ 1 i))
)
)
(progn
(set_tile "ltpe" str)
(setq piklst str)
)
)
(mode_tile "sel_all" 1)
(mode_tile "sel_all" 4)
(mode_tile "clr_all" 0)
(mode_tile "clr_all" 4)
(mode_tile "accept" 0)
(mode_tile "accept" 4)
)
(defun do_piklst ()
(setq piklst $value)
(mode_tile "sel_all" 0)
(mode_tile "sel_all" 4)
(mode_tile "clr_all" 0)
(mode_tile "clr_all" 4)
(mode_tile "accept" 0)
(mode_tile "accept" 4)
)
(setq stid 2)
(do_file_def)
(while (> stid 1)
(IF (new_dialog "ltp" dcl_id)
(progn
(setq LTP_LIST (acad_strlsort (lt_lst aec_acadlinfile)))
(start_list "ltpe")
(mapcar 'add_list LTP_LIST)
(end_list)
(setq piklst "0")
(set_tile "ltpe" "0")
(set_tile "file_lt" (jname aec_acadlinfile))
(action_tile "sel_all" "(sel_all LTP_LIST)")
(action_tile "clr_all" "(clr_all LTP_LIST)")
(action_tile "file_bt" "(done_dialog 2)")
(action_tile "ltpe" "(do_piklst)")
(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq stid (START_DIALOG))
(cond
((= 1 stid)(upd_ltp))
((= 2 stid)(do_file))
)
) ; progn
) ; if
) ; while
) ; defun

;;
;; This function pops a dialogue box consisting of a list box, image tile,
;; and edit box to allow the user to select or type a linetype. It returns
;; the linetype selected.
;;
(defun getltype (/ old-idx ltname statid)
(if (not (new_dialog "ddchlt" dcl_id)) (exit))
(start_list "list_lt")
(mapcar 'add_list ltnmlst) ; initialize list box
(end_list)
(setq old-idx lt-idx)
;; Show initial ltype in image tile, list box, and edit box
(if (/= lt-idx nil)
(ltlist_act (itoa lt-idx))
(progn
(set_tile "edit_lt" "Varies")
(col_tile "show_image" 0 nil)
)
)
(set_tile "lyrname" (strcat"Layer Name: " lyrname))
(action_tile "list_lt" "(ltlist_act $value)")
(action_tile "edit_lt" "(ltedit_act)")
(action_tile "load_lt" "(done_dialog 2)")
(action_tile "accept" "(test-ok)")
(action_tile "cancel" "(reset-lt)")
(setq statid(start_dialog))
(cond
((= statid 1) ; User pressed OK
ltname
)
((= statid 2)
; (command"_.Linetype""_Load""*""""") ; load all linetypes
(acad_ltp)
(makeltlists) ; linetype lists - ltnmlst, mdashlist
(setq lt-idx (getindex ltname ltnmlst))
(getltype)
)
)
)
;;
;; Edit box entries end up here
;;
(defun ltedit_act ()
;; If linetype name,is valid, then clear error string,
;; call ltlist_act function, and change focus to list box.
;; Else print error message.
(setq ltvalue (xstrcase (get_tile "edit_lt")))
(if (setq lt-idx (getindex ltvalue ltnmlst))
(progn
(set_tile "error" "")
(ltlist_act (itoa lt-idx))
(mode_tile "list_lt" 2)
)
(progn
(set_tile "error" "Invalid linetype.")
(setq lt-idx old-idx)
)
)
)
;;
;; List selections end up here
;;
(defun ltlist_act (index / dashdata)
;; Update the list box, edit box, and color tile
(set_tile "error" "")
(setq lt-idx (atoi index))
(setq ltname (nth lt-idx ltnmlst))
(setq dashdata (nth lt-idx mdashlist))
(col_tile "show_image" 0 dashdata)
(set_tile "list_lt" (itoa lt-idx))
(set_tile "edit_lt" ltname)
)
;;
;; Reset to original linetype when cancel it selected
;;
(defun reset-lt ()
(setq lt-idx old-idx)
(done_dialog 0)
)
;;
;; If there is no error message, then close the dialogue
;;
;; If there is an error message, then set focus to the tile
;; that's associated with the error message.
;;
(defun test-ok ( / errtile)
(setq errtile (get_tile "error"))
(cond
( (= errtile "")
(done_dialog 1))
( (= errtile "Invalid linetype.")
(mode_tile "list_lt" 2))
)
)
;;
;; If an item is a member of the list, then return its index number, else
;; return nil.
;;
(defun getindex (item itemlist / m n)
(setq n (length itemlist))
(if (> (setq m (length (member item itemlist))) 0)
(- n m)
nil
)
)
; ini_dlg initializes the dialog box
(defun ini_dlg (/ layer ltype obj pikopt ss)
(makeltlists) ; linetype lists - ltnmlst, mdashlist
(setq dcl_id (load_dialog (strcat (GETVAR"TEMPPREFIX")"DDCHLT.DCL")))
; (initget "Y N")
; (setq pikopt (getkword"\nPick Nested Object : "))
; (if(not pikopt)(setq pikopt "N"))

; (if(= pikopt "Y")
; (setq obj (nentsel "\nSelect an object on layer to change linetype: ")) ; this will select nested objects
; (setq obj (entsel "\nSelect an object on layer to change linetype: "))
; )

(setq layer (entget(tblobjname "layer" (setq lyrname (getvar "clayer")))))
; (setq layer (entget(tblobjname "layer" (setq lyrname(cdr (assoc 8 (entget (car obj))))))))
;; Find index of linetype, and layer lists
(setq ltname (cdr (assoc 6 layer)))
(setq lt-idx (getindex ltname ltnmlst))
(setq ltype (getltype))
(if ltype
(command"_.Layer""_Ltype" ltype lyrname "")
) ; if ltype

) ; defun ini_dlg

(push_echo) ; pushes environment settings
(setq ddchlt_olderr *error* ; Save error routine
*error* DDCHLT_err ; Substitute ours
)
(wrt_dlg)
(ini_dlg)
(clr_dlg)
(if ddchlt_olderr (setq *error* ddchlt_olderr)) ;REStore old *error* handler
(put_echo)(PRINC) ; puts back environment settings
)(princ)
(princ"loaded.")(princ)
(c:ddc)

Advertisements