Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Layer Index Color Change via Selection and Dialog Box

10 REPLIES 10
SOLVED
Reply
Message 1 of 11
cgentile
3088 Views, 10 Replies

Layer Index Color Change via Selection and Dialog Box

Hi, I'm attempting to create an easier way to change layer colors of nested linework by selecting the linework and having the ACAD index color dialog box appear to select the replacement color.

 

I need help with defining the "ic" variable; any other suggestions are welcomed as well.

 

Thank you in advance!

 

(defun c:clc (/ ent ent_data ic ent_lay) ;change layer color
(setq ent
(nentsel)
)  
(setq ent_data
(entget
(car ent)
)
)
(setq ic ;index color
(cdr
(assoc 62
(ACAD_COLORDLG)
)
)
)
(setq ent_lay
(cdr
(assoc 8 ent_data)
)
)
(command "-layer" "c" ic ent_lay "")
)

 

10 REPLIES 10
Message 2 of 11
alanjt_
in reply to: cgentile


@cgentile wrote:

Hi, I'm attempting to create an easier way to change layer colors of nested linework by selecting the linework and having the ACAD index color dialog box appear to select the replacement color.

 

I need help with defining the "ic" variable; any other suggestions are welcomed as well.

 

Thank you in advance!

 

(defun c:clc (/ ent ent_data ic ent_lay) ;change layer color
(setq ent
(nentsel)
)  
(setq ent_data
(entget
(car ent)
)
)
(setq ic ;index color
(cdr
(assoc 62
(ACAD_COLORDLG)
)
)
)
(setq ent_lay
(cdr
(assoc 8 ent_data)
)
)
(command "-layer" "c" ic ent_lay "")
)

 


(defun c:Test (/ ent layer color)
  (if (and (setq ent (car (nentsel "\nSelect object on layer to change color: "))) ; select nested object
           (setq color
                  (acad_colordlg ; execute function
                    (cdr (assoc 62 ; extract color from layer definition
                                (tblsearch "LAYER" ; get layer definition
                                           (setq layer (cdr (assoc 8 ; extract layer name from entity data
                                                                   (setq data (entget ent)) ; entity data from entity
                                                            )
                                                       )
                                           )
                                )
                         )
                    )
                    nil ; removes the ability to select "ByLayer" or "ByBlock" in the color dialog
                  )
           )
      )
    (command "_.-layer" "_color" color layer "") ; change color of layer of selected object
  )
  (princ)
)

 

Message 3 of 11
cgentile
in reply to: alanjt_

Thank you! That works great, but I screwed it up trying to add a linetype change. Followed process from *A+P comment here: http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/lisp-to-change-linetype-of-layer/td-p...

 

(defun c:layj (/ ent layer color line)
  (if (and (setq ent (car (nentsel "\nSelect object on layer to change: "))) ; select nested object
           (setq color
		  (acad_colordlg ; execute function
                    (cdr (assoc 62 ; extract color from layer definition
                                (tblsearch "LAYER" ; get layer definition
                                           (setq layer (cdr (assoc 8 ; extract layer name from entity data
                                                                   (setq data (entget ent)) ; entity data from entity
                                                            )
                                                       )
                                           )
                                )
                         )
                    )
                    nil ; removes the ability to select "ByLayer" or "ByBlock" in the color dialog
                  )
           )
           (setq line
                 (initdia) (command "linetype") ; execute function
                    (cdr (assoc 6 ; extract linetype from layer definition
                                (tblsearch "LAYER" layer) ; get layer definition
				)
			 )
		 )
	   )
    (command "-layer" "color" color layer "") ; change color of layer of selected object
    (command "-layer" "linetype" line layer ""); change linetype of layer of selected object
(command "regen"); required to show lintype change ) (princ) )

 

Message 4 of 11
Lee_Mac
in reply to: cgentile

Unfortunately, you cannot use the LINETYPE command to prompt the user for a linetype, since the command call will not return any selected linetype to the program, and, although you could conceivably test the value of the CELTYPE system variable (the active linetype), there is no guarantee that the user has set the selected linetype as the current linetype.

 

I believe the DosLIB library provides a function to prompt the user using an appropriate linetype selection dialog, but since this requires installation of a third-party extension it may not be a viable option where program distribution is concerned.

 

Another option is to roll-your-own dialog prompt, for example:

 

(defun c:layj ( / col ent lay typ )
    (while
        (progn (setvar 'errno 0)
            (not
                (or (setq ent (car (nentsel "\nSelect object on layer to change: ")))
                    (= 52 (getvar 'errno))
                )
            )
        )
        (princ "\nMissed, try again.")
    )
    (if
        (and ent
            (setq col
                (acad_colordlg
                    (cdr
                        (assoc 62
                            (tblsearch "layer"
                                (setq lay (cdr (assoc 8 (entget ent))))
                            )
                        )
                    )
                    nil
                )
            )
            (setq typ
                (LM:listbox "Select Linetype"
                    (
                        (lambda ( / def lst )
                            (while (setq def (tblnext "ltype" (null def)))
                                (if (wcmatch (cdr (assoc 2 def)) "~*|*")
                                    (setq lst (cons (cdr (assoc 2 def)) lst))
                                )
                            )
                            (acad_strlsort lst)
                        )
                    )
                    nil
                )
            )
        )
        (command "_.-layer" "_C" col lay "_L" (car typ) lay "" "_.regen")
    )
    (princ)
)

;; List Box  -  Lee Mac
;; Displays a List Box allowing the user to make a selection from the supplied data.
;; msg - [str] Dialog label
;; lst - [lst] List of strings to display
;; mtp - [bol] t=allow multiple
;; Returns: [lst] List of selected items, else nil

(defun LM:listbox ( msg lst mtp / dch des tmp res )
    (cond
        (   (not
                (and
                    (setq tmp (vl-filename-mktemp nil nil ".dcl"))
                    (setq des (open tmp "w"))
                    (write-line
                        (strcat "listbox : dialog { label=\"" msg
                            "\"; spacer; : list_box { key=\"list\"; multiple_select="
                            (if mtp "true" "false") "; } spacer; ok_cancel; }"
                        )
                        des
                    )
                    (not (close des))
                    (< 0 (setq dch (load_dialog tmp)))
                    (new_dialog "listbox" dch)
                )
            )
            (prompt "\nError Loading List Box Dialog.")
        )
        (   t     
            (start_list "list")
            (foreach itm lst (add_list itm))
            (end_list)
            (setq res (set_tile "list" "0"))
            (action_tile "list" "(setq res $value)")
            (setq res
                (if (= 1 (start_dialog))
                    (mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" res ")")))
                )
            )
        )
    )
    (if (< 0 dch)
        (unload_dialog dch)
    )
    (if (and tmp (setq tmp (findfile tmp)))
        (vl-file-delete tmp)
    )
    res
)

(princ)

 

Message 5 of 11
econnerly
in reply to: Lee_Mac

Lee,
This is an great routine and I have been using something simular for years. I have always wondered if there was a way to modify it so that you could pick mulitple layers first and then have the dialog box come up. That way you could change all the selected layers you want to a specific color / linetype at the same time. Is this possible?

Message 6 of 11
alanjt_
in reply to: Lee_Mac

Here's a quickie example using the linetype description to mimic the native lintype select a little closer.

 

Also, in the r14 days, before the properties pallette, Express Tools was called Bonus Tools and it had a function called Extended Change Properties. Within the dialog for lintype selection, it had a crude, but elegant way of displaying the linetypes when selected from a list. It didn't work with linetyps that had text or special characters, but it was still pretty cool. See attached screenshot image.

The properties pallete made Extended Change Properties obsolute, but with some drawings, I've encountered serious lag when selecting an object, when the properties palette is open. When I have those situations, ECP becomes the trusty go-to.

 

 

 

(defun c:LType (/ _pad AT:ListSelect def str lst lst2 ltype wid)
  ;; linetype dialog list select example using linetype name and description for selection.
  ;; I'm fully aware the coding isn't pretty or efficient. It's an example, so hush.
  ;; Alan J. Thompson, 2014.10.02


  (defun _pad (s l)
    (if (< (strlen s) l)
      (_pad (strcat s " ") l)
      s
    )
  )

  (defun AT:ListSelect (title label height width multi lst / fn fo d item f)
    ;; List Select Dialog (Temp DCL list box selection, based on provided list)
    ;; title - list box title
    ;; label - label for list box
    ;; height - height of box
    ;; width - width of box
    ;; multi - selection method ["true": multiple, "false": single]
    ;; lst - list of strings to place in list box
    ;; Alan J. Thompson, 09.23.08 / 05.17.10 (rewrite)
    (setq fo (open (setq fn (vl-filename-mktemp "" "" ".dcl")) "w"))
    (foreach x (list (strcat "list_select : dialog { label = \"" title "\"; spacer;")
                     (strcat ": list_box { label = \"" label "\";" "key = \"lst\";")
                     (strcat "allow_accept = true; height = " (vl-princ-to-string height) ";")
                     (strcat "width = " (vl-princ-to-string width) ";")
                     (strcat "multiple_select = " multi "; } spacer; ok_cancel; }")
               )
      (write-line x fo)
    )
    (close fo)
    (new_dialog "list_select" (setq d (load_dialog fn)))
    (start_list "lst")
    (mapcar (function add_list) lst)
    (end_list)
    (setq item (set_tile "lst" "0"))
    (action_tile "lst" "(setq item $value)")
    (setq f (start_dialog))
    (unload_dialog d)
    (vl-file-delete fn)
    (if (= f 1)
      ((lambda (s / i s l)
         (while (setq i (vl-string-search " " s))
           (setq l (cons (nth (atoi (substr s 1 i)) lst) l))
           (setq s (substr s (+ 2 i)))
         )
         (reverse (cons (nth (atoi s) lst) l))
       )
        item
      )
    )
  )



  (while (setq def (tblnext "ltype" (null def)))
    (if (wcmatch (cdr (assoc 2 def)) "~*|*")
      (setq lst (cons (cons (cdr (assoc 2 def)) (cdr (assoc 3 def))) lst))
    )
  )

  (setq wid  (apply 'max (mapcar (function (lambda (x) (strlen (car x)))) lst))
        lst2 (mapcar (function (lambda (x) (cons (strcat (_pad (car x) wid) "  " (cdr x)) (car x)))) lst)
  )

  (if (setq ltype (car (AT:ListSelect
                         "Select linetype:"
                         ""
                         15
                         (apply 'max (mapcar (function (lambda (x) (strlen (car x)))) lst2))
                         "false"
                         (acad_strlsort (mapcar 'car lst2))
                       )
                  )
      )
;;;    (setq ltype (LM:listbox "Select linetype:" (acad_strlsort (mapcar 'car lst2)) nil))
    (alert (strcat "Linetype selected: " (cdr (assoc ltype lst2))))
  )

  (princ)
)

 

Message 7 of 11
cwilczak
in reply to: alanjt_

Looking for a way to set a user selected specific entity layer (lets say its an nested hatch object in an xref), and i want to set the layer transparency to a user entered value. Is there a way to modify this code to do so? 

Message 8 of 11
ВeekeeCZ
in reply to: cwilczak


@cwilczak wrote:

Looking for a way to set a user selected specific entity layer (lets say its an nested hatch object in an xref), and i want to set the layer transparency to a user entered value. Is there a way to modify this code to do so? 


 

Like this?

(defun c:TrN ( / l r)

  (if (and (setq l (car (nentsel "\nPick a nested layer: ")))
	   (setq l (cdr (assoc 8 (entget l))))
	   (setq r (getint (strcat "\nSpecify transparency (0-90) of '" l "': ")))
	   )
    (command "_.layer" "_Tr" r l ""))
  (princ)
  )
Message 9 of 11
cwilczak
in reply to: ВeekeeCZ

After spending hours without luck trying to code myself with no luck, this is exactly what I was looking for, thank you for the quick reply.

Message 10 of 11
ВeekeeCZ
in reply to: cwilczak

Those hours will pay off someday.
Message 11 of 11
JimsTools
in reply to: cgentile

Way late on this one, but wanted to share this tool I created way back in 2000 by hacking together the old R14 layer properties LSP and the Express Tools layer Isolate LSP. It was my first program in AutoLisp, and it's also my most useful. Please enjoy for free!

 

@Lee_Mac I am sure a bit of your brilliance is in here too somewhere. Pretty sure I studied your layer transparency code and incorporated what I could understand.

 

XLayer Extended Modify Layer 

https://bit.ly/xlayerweb

Jim Smith

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost