Message 1 of 7
Lisp doesn't works in normal AutoCad but not in AutoCad Mechanical

Not applicable
01-12-2021
06:28 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello everybody,
I am using 2 lisps to change the layers in a block to the layer of the block and the colors from objects in a block into the color "bylayer" from the block.
For example; If the color of the block (layer A) is grey, and the colors of the layers B and C in this block are yellow and red (not bylayer), they must become grey also.
If I use them in AutoCad 2016 - 2019, it isn't a problem. But if I use the lisp for changing colors in AutoCad Mechanical 2019 it doesn't work.
Could somebody help me with this?
Thank you
;**********Routine to change the color of a block**********
(defun C:cbl (/ CNT CMD EN1 EN2 EG1 EG2 NAM SS1)
(setq CMD (getvar "CMDECHO"))
(setvar "CMDECHO" 1)
(load "ai_utils")
(setq blk_list (ai_table "block" 12)) ; no Xrefs or
; Xref dependents.
(if (>= (getvar "maxsort") (length blk_list)) ; Alphabetize if greater
(if blk_list (setq blk_list (acad_strlsort blk_list))) ; than maxsort.
)
(setq old_vp (getvar "cvport");save current viewport
old_tile (getvar "tilemode");save current tilemode
c_layer (getvar "layer")
old_expert (getvar "expert"));save current layr
(command "view" "s" "CBL")
(ddslayer);save current layer settings
(command "layer" "set" "0" "")
(setvar "cmdecho" 1);debug
(command "layer" "thaw" "*" "on" "*" "unlock" "*" "");thaw, on, unlock all
(setq rep 0)
(repeat (length blk_list) ;process block list
(BCBL (nth rep blk_list))
(setq rep (+ 1 rep))
)
(COMMAND "change" "all" "" "p" "c" "bylayer" "")
;restore commands here
(command "zoom" "e")
(ddrlayer) ;restore layer settings
(command "layer" "set" c_layer "");set back to original layer
(command "view" "r" "CBL")
(setvar "attreq" old_attreq)
(setvar "expert" old_expert)
(prin1)
(princ "\n\tLoaded CBL.LSP. Type CBL to begin.")
(princ)
); end
;layer setting save routine
(defun ddslayer ()
(setq
c_lay (getvar "clayer")
lay_set_list nil
layer_name (tblnext "layer" "T")
)
(while layer_name
(setq lay_set (get_set layer_name))
(setq layer_list (append layer_list (list lay_set)))
(setq layer_name (tblnext "layer"))
)
)
;-------------------------------------------------?----
; BIT SET
;-------------------------------------------------?----
(defun BITSET (A B) (= (boole 1 A B) B))
;-------------------------------------------------?----
; DXFGET
;-------------------------------------------------?----
(defun DXFGET (A B) (cdr (assoc A B)))
;-------------------------------------------------?----
; Get layer settings
;-------------------------------------------------?----
(defun get_set (LAYER)
(if LAYER
(list
(> (DXFGET 62 LAYER) 0) ;negative if off
(bitset (DXFGET 70 LAYER) 1) ;set if frozen
(bitset (DXFGET 70 LAYER) 4) ;set if locked
(DXFGET 2 LAYER) ;layer name
)
)
)
(defun ddrlayer() ;layer restore routine
(command "regenauto" "off")
(setq rep 0)
(command ".layer")
(repeat (length layer_list)
(setq t_layer (nth rep layer_list)
l_name (cadddr t_layer)
)
(command
(if (car t_layer) "on" "off") l_name)
(command
(if (cadr t_layer) "freeze" "thaw") l_name)
(command
(if (caddr t_layer) "lock" "unlock") l_name)
(setq rep (+ 1 rep))
)
(command "")
)
(princ)
(prompt "\n\t\tStart with 'CBL'")(prin1)
;end
;---Loop through entities in the block---
(defun BCBL (NAM)
(SETQ EN2 (cdr (assoc -2 (tblsearch "BLOCK" NAM)))
)
(PRBLK EN2 NAM)
(setvar "CMDECHO" CMD)
(princ)
)
;*******Subroutine to change color and layer********
(defun PRBLK (EN2 NAM)
(setq CNT 0)
(while EN2
(setq CNT (1+ CNT)
EG2 (entget EN2)
EN2 (entnext (cdr (assoc -1 EG2)))
)
(grtext -2 (strcat NAM " block entity # " (itoa CNT)))
;---Check color---
(if (assoc 62 EG2)
(setq EG2 (subst (cons 62 256) (assoc 62 EG2) EG2))
(setq EG2 (append EG2 (list (cons 62 256))))
)
(entmod EG2)
;---Set to layer 0---
(if (/= (cdr (assoc 8 EG2)) "0")
(progn
(setq EG2 (subst (cons 8 "0") (assoc 8 EG2) EG2))
(entmod EG2)
)
)
;---Check for nested blocks---
(if (= (cdr (assoc 0 EG2)) "INSERT")
(progn
(setq NM2 (cdr (assoc 2 EG2))
EN3 (cdr (assoc -2 (tblsearch "BLOCK" NM2)))
)
(PRBLK EN3 NM2)
)
);endif
)
---Update all blocks in the drawing---
(setq SS1 (ssget "X" (list (cons 2 NAM)));find all insertions of that block, if any
CNT 0)
(if SS1 (progn
(setq C (- (sslength SS1) 1)) ; set counter
(while (>= C CNT) ; while entities in the list
(setq EN1 (ssname SS1 CNT))
(setq CNT (1+ CNT))
(entupd EN1)
);end while C
);progn
);if SS1
);defun