Jump to content
CAD_Noob

Demo Lisp

Recommended Posts

CAD_Noob
Posted (edited)

I found this lisp by Kent which enable the user to pick an entity and add "-DEMO" to its layer name, change its color and linetype which is working great.

Can this be modified to accept multiple selection rather than by pick only.
And if i select a block if does not change the color and linetype.

 

(defun c:DEMO (/ esel ent DLname)
  (while (setq esel (entsel "\nPick object to put on its Demo Layer: "))
    (setq
      ent (car esel)
      DLname (strcat (cdr (assoc 8 (entget ent))) "-DEMO")
    )
    (command
      "_.layer" "_make" DLname "_color" 40 "" "_ltype" "HIDDEN2" "" ""
      "_.chprop" ent "" "_layer" DLname ""
    )
  )
  (princ)
)

 

Edited by CAD_Noob
typo error

Share this post


Link to post
Share on other sites
Emmanuel Delay
Posted (edited)

Sure, I renamed the command CLCL

 

(defun change_layer_color_ltp ( ent /  DLname)
    (setq
      ;;ent (car esel)
      DLname (strcat (cdr (assoc 8 (entget ent))) "-DEMO")
    )
    (command
      "_.layer" "_make" DLname "_color" 40 "" "_ltype" "HIDDEN2" "" ""
      "_.chprop" ent "" "_layer" DLname ""
    )
  (princ)
)

(defun c:clcl ( / ss i)
  ;; selection
  (princ "\nMake selection: ")
  (setq ss (ssget))
  ;; now perform the function for every selected entity
  (setq i 0)
  (repeat (sslength ss)
    (change_layer_color_ltp (ssname ss i))
    (setq i (+ i 1))
  )
  (princ)
)

Edited by Emmanuel Delay
  • Thanks 1

Share this post


Link to post
Share on other sites
CAD_Noob
3 hours ago, Emmanuel Delay said:

Sure, I renamed the command CLCL

 


(defun change_layer_color_ltp ( ent /  DLname)
    (setq
      ;;ent (car esel)
      DLname (strcat (cdr (assoc 8 (entget ent))) "-DEMO")
    )
    (command
      "_.layer" "_make" DLname "_color" 40 "" "_ltype" "HIDDEN2" "" ""
      "_.chprop" ent "" "_layer" DLname ""
    )
  (princ)
)

(defun c:clcl ( / ss i)
  ;; selection
  (princ "\nMake selection: ")
  (setq ss (ssget))
  ;; now perform the function for every selected entity
  (setq i 0)
  (repeat (sslength ss)
    (change_layer_color_ltp (ssname ss i))
    (setq i (+ i 1))
  )
  (princ)
)

 

Hi @Emmanuel Delay; thanks for this. Will try tomorrow as I do not have AutoCAD at home.

 

  • Like 1

Share this post


Link to post
Share on other sites
CAD_Noob

Thanks so much! working well.

Just need to edit some blocks to ByLayer for the routine to take effect.

Some blocks are a bit hard to edit though there are couples of nested block 

Share this post


Link to post
Share on other sites
CAD_Noob

Hi found a bug...
if the selected item happens to be in the demo layer already it again adds "-DEMO" suffix.

Example : 
Before : A-_Door-DEMO
After : A-_Door-DEMO-DEMO

Share this post


Link to post
Share on other sites
dlanorh

It's not a bug, it's user error for selecting an entity on a layer with the suffix "-DEMO" :lol:

 

A belt and braces lisp. You can't select a layer with "-DEMO" in the layer name

If the layer already has an associated "-demo" layer it moves it to that layer 

Otherwise it creates the demo layer and moves it.

 


(defun change_layer_color_ltp ( ent /  dlname)
    (setq dlname (cdr (assoc 8 (entget ent))))
    (cond ( (and (not (wcmatch (strcase dlname) "*-DEMO"))
                 (setq dlname (strcat dlname "-DEMO"))
                 (not (tblsearch "layer" dlname))
            )
            (command "_.layer" "_make" dlname "_color" 40 "" "_ltype" "HIDDEN2" "" ""
                    "_.chprop" ent "" "_layer" DLname ""
            )
          )
          ( (tblsearch "layer" dlname) (command "_.chprop" ent "" "_layer" dlname ""))
    )
  (princ)
)

(defun c:clcl ( / ss i)
  ;; selection
  (princ "\nMake selection: ")
  (setq ss (ssget '((-4 . "<NOT") (8 . "*DEMO") (-4 . "NOT>"))))
  ;; now perform the function for every selected entity
  (setq i 0)
  (repeat (sslength ss)
    (change_layer_color_ltp (ssname ss i))
    (setq i (+ i 1))
  )
  (princ)
)

 

  • Like 1

Share this post


Link to post
Share on other sites
CAD_Noob
14 hours ago, dlanorh said:

It's not a bug, it's user error for selecting an entity on a layer with the suffix "-DEMO" :lol:

 

A belt and braces lisp. You can't select a layer with "-DEMO" in the layer name

If the layer already has an associated "-demo" layer it moves it to that layer 

Otherwise it creates the demo layer and moves it.

 


(defun change_layer_color_ltp ( ent /  dlname)
    (setq dlname (cdr (assoc 8 (entget ent))))
    (cond ( (and (not (wcmatch (strcase dlname) "*-DEMO"))
                 (setq dlname (strcat dlname "-DEMO"))
                 (not (tblsearch "layer" dlname))
            )
            (command "_.layer" "_make" dlname "_color" 40 "" "_ltype" "HIDDEN2" "" ""
                    "_.chprop" ent "" "_layer" DLname ""
            )
          )
          ( (tblsearch "layer" dlname) (command "_.chprop" ent "" "_layer" dlname ""))
    )
  (princ)
)

(defun c:clcl ( / ss i)
  ;; selection
  (princ "\nMake selection: ")
  (setq ss (ssget '((-4 . "<NOT") (8 . "*DEMO") (-4 . "NOT>"))))
  ;; now perform the function for every selected entity
  (setq i 0)
  (repeat (sslength ss)
    (change_layer_color_ltp (ssname ss i))
    (setq i (+ i 1))
  )
  (princ)
)

 

 

Thanks for the fix, sometimes some of those demo layers are accidentally selected when windowing

Share this post


Link to post
Share on other sites
CAD_Noob
15 hours ago, dlanorh said:

It's not a bug, it's user error for selecting an entity on a layer with the suffix "-DEMO" :lol:

 

A belt and braces lisp. You can't select a layer with "-DEMO" in the layer name

If the layer already has an associated "-demo" layer it moves it to that layer 

Otherwise it creates the demo layer and moves it.

 


(defun change_layer_color_ltp ( ent /  dlname)
    (setq dlname (cdr (assoc 8 (entget ent))))
    (cond ( (and (not (wcmatch (strcase dlname) "*-DEMO"))
                 (setq dlname (strcat dlname "-DEMO"))
                 (not (tblsearch "layer" dlname))
            )
            (command "_.layer" "_make" dlname "_color" 40 "" "_ltype" "HIDDEN2" "" ""
                    "_.chprop" ent "" "_layer" DLname ""
            )
          )
          ( (tblsearch "layer" dlname) (command "_.chprop" ent "" "_layer" dlname ""))
    )
  (princ)
)

(defun c:clcl ( / ss i)
  ;; selection
  (princ "\nMake selection: ")
  (setq ss (ssget '((-4 . "<NOT") (8 . "*DEMO") (-4 . "NOT>"))))
  ;; now perform the function for every selected entity
  (setq i 0)
  (repeat (sslength ss)
    (change_layer_color_ltp (ssname ss i))
    (setq i (+ i 1))
  )
  (princ)
)

 

 

one last request please? exclude xref from the selection...

 

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...