Hello,
This is my first post here and I am definetly a learning novice to the world of Lisp writing/editing. I am editing a lisp that my company has been using to change the construction phase of elements..ie from h-duct_sup_exist to h-duct_sup_demo. I want this routine now to take my annotations from the 1/8 scale layers to the 1/4 scale layers which read like h-text8_cfm_new to h-text4_cfm_new. Ive gotten this far, then ran into a snag. It would work great if we were a single discipline using this lisp, but we also have plumbing and fp in house. Now the delimiters are the same, but the discipline changes, ie. h-text8_pipe_new or p-text8_pipe_new. The program trims to the _ delimeter as is and chops the layers in half, and can replace the whole h-text8, but that only works for h discipline. Im stuck, and its driving me batty trying to figure out a way to trim and replace the original discipline variable to the layer.
;;;; 24.LSP - Changes picked objects to the corresponding "h-text4" Layer. ;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(vl-load-com)
(defun C:24 ( / SS CNT LYR SLYR vEN EN LyrNew LyrTab oLayers tChr nSuf nPre )
(prompt "\nChange selected objects layer by changing the suffix.")
;;
(setq tChr "_") ;;<<-- variable delimiter
(setq nSuf "") ;;<<--- your new suffix
(setq nPre "h-text4") ;;<<--- 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))
; (vla-put-truecolor LyrNew (vla-get-truecolor LyrTab))
; (vla-put-freeze LyrNew (vla-get-freeze LyrTab))
; (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
(princ)
)
;; END OF LISP
