Hi I have recently upgraded from 2009 to 2015 and have a little issue with the attached lisp.
The lisp will put selected objects onto a frozen layer prefixed with 'clashing-".
The problem is with attributed blocks the block remains on screen until I pan or zoom. I have tried adding (command “zoom” sc “.99xp”) to the end of the lisp but it hasn't fixed the issue.
I'm not sure if it is an issue with the lisp or my autocad. Has anything changed in autocad of the last few years which could cause this behaviour?
I would appreciate it if someone could have a look please.
;; http://forums.augi.com/showthread.php?t=133972
;; Demonstration of how object layers can be manipulated.
;; Also demonstrates string parsing, destruction, and reconstruction
;; tricks available in Visual LISP.
;;
(vl-load-com)
(defun c:cl (/) (C:clashing_Levels)) ; shortcut
(defun C:clashing_Levels ( / SS CNT LYR SLYR vEN EN LyrNew LyrTab oLayers tChr nSuf nPre)
(prompt "\nChange selected objects to layer prefixed by 'Clashing':")
;;
(setq tChr "_") ;;<<-- variable delimiter
; (setq tChr "-") ;;<<-- variable delimiter
(setq nSuf "") ;;<<--- your new suffix
(setq nPre "Clashing - ") ;;<<--- your new prefix
;;
(setq SS (ssget))
(if (and SS (> (sslength SS) 0))
(progn
(setq oLayers ;;get layer table link
(vla-get-layers
(vla-get-activedocument
(vlax-get-acad-object))))
;;
;;Got the objects, now stream through them
(repeat (setq CNT (sslength SS))
;;
(setq En (ssname SS (setq CNT (1- CNT))) ;;Entity name from set
vEN (vlax-ename->vla-object En) ;;entity object reference
LYR (vla-get-layer vEN);;get the layer name
sLYR LYR
)
;;
;;check to see if already changed
;;
(if (not (wcmatch LYR (strcat nPre "*" nSuf)))
(progn
;;
;; LYR does not match the pattern test
;;
;; Change the prefix only if nPRE is not empty and the
;; delimeter can be found in the source layer name.
;;
(if (/= nPRE "") ;;change the prefix?
(progn
(if (wcmatch LYR (strcat "*" tChr "*")) ;;find the delim?
(setq LYR (vl-string->list LYR) ;;change to list
LYR (member (ascii tChr) LYR) ;;trim to delim
LYR (vl-list->string LYR)) ;;back to string
)
(setq LYR (strcat nPRE LYR)) ;;add new prefix
)) ;;end IF nPRE progn
;;
(if (/= nSUF "") ;;change the suffix?
(progn
(if (wcmatch LYR (strcat "*" tChr "*")) ;;find the delim okay?
(setq LYR (vl-string->list LYR) ;;convert LYR name to list of ASCIIs
LYR (reverse LYR) ;;flip it around
LYR (member (ascii tChr) LYR) ;;trim to delim
LYR (reverse LYR) ;;flip it back to forward
LYR (vl-list->string LYR)) ;;back to string
)
(setq LYR (strcat LYR nSUF))
)) ;;end IF nSUF progn
;;
;; Check to see if the new layer exists
;;
(if (not (tblsearch "LAYER" LYR))
(progn ;;add the new layer
(setq LyrNew (vla-add oLayers LYR)
LyrTab (vla-item oLayers sLYR)
)
;; Clone the properties
(vla-put-linetype LyrNew (vla-get-linetype LyrTab)) ; clone layer linetype
; (vla-put-Linetype LyrNew "HIDDEN") ; set layer linetype hidden
; (vla-put-color LyrNew 6) ; set layer colour
(vla-put-truecolor LyrNew (vla-get-truecolor LyrTab)) ; clone layer colour
(vla-put-freeze LyrNew :vlax-true) ; set layer freeze state
; (vla-put-freeze LyrNew (vla-get-freeze LyrTab)) ; clone layer freeze state
(vla-put-layeron LyrNew (vla-get-layeron LyrTab))
(vla-put-lineweight LyrNew (vla-get-lineweight LyrTab))
(vla-put-lock LyrNew (vla-get-lock LyrTab))
(vla-put-material LyrNew (vla-get-material LyrTab))
;(vla-put-plotstylename LyrNew (vla-get-plotstylename LyrTab))
)) ;;end layer add
;;
;; Update the layer name of the object
(vla-put-layer vEN LYR)
)) ;;end if _DEMO already there
) ;;end REPEAT
)) ;;end SS test
(command “zoom” sc “.99xp”) ; pb added to try and fix display issue
(princ)
)
