Help with code to change transparency on XREF layers

[cadd4la]

Hi everyone,

I've taken this code as far as I can, and I'm looking for help to fix the issues. I want the transparency changed to 50% for the XREF files, but also skip some XREF files and certain layers that are XREF in the file.


(defun c:XREFTR50 ( / *error* doc layers layer lname upper xref-root
lay-color lay-plottable skip-names split-pos skip-xref )

;; Error handler
(defun *error* (msg)
(prompt (strcat "\nError: " msg))
(princ)
)

(vl-load-com)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
layers (vla-get-Layers doc)
skip-names '("*|SCANS" "*|IMAGES" "*|XREF")
;;skip-names '("SCANS" "IMAGES" "XREF")
)

(vlax-for layer layers
(setq lname (vla-get-Name layer))
(if (and lname (= (type lname) 'STR) (vl-string-search "|" lname))
(progn
;; Normalize name
(setq upper (strcase lname))

;; Extract xref-root from "<xref>|<layer>"
(setq split-pos (vl-string-search "|" lname))
(setq xref-root (strcase (substr lname 1 split-pos)))

;; Get layer color and plottable
(setq lay-color (vla-get-Color layer))
(setq lay-plottable (vla-get-Plottable layer))

;; Match XREF file name pattern
(setq skip-xref
(or (wcmatch xref-root "*_24VDG*")
(wcmatch xref-root "*_30VDG*")
(wcmatch xref-root "*_24X36*")
(wcmatch xref-root "*_30X36*")
)
)

;; Apply command if all filters pass
(if (and
(not (member upper skip-names))
(/= lay-color 200)
(eq lay-plottable :vlax-true)
(not skip-xref)
)
(progn
(prompt (strcat "\nSetting transparency to 50 for layer: " lname))
(command "_.-layer" "_tr" "50" lname "")
)
)
)
)
)

(prompt "\nTransparency update complete.")
(princ)
)


The code runs but slowly because it goes through all the XREF layers and will not skip the layers that are listed in the code.

I have tried to use the following and it still don't skip these layers

skip-names '("*|SCANS" "*|IMAGES" "*|XREF")
;;skip-names '("SCANS" "IMAGES" "XREF")

Thanks for your help,

CAD4LA

[PaulLi_apa]

well these don't work:

skip-names '("*|SCANS" "*|IMAGES" "*|XREF")
;;skip-names '("SCANS" "IMAGES" "XREF")
because of the following code you're using to check:

(not (member upper skip-names))
Let's say your Layer name which you're checking contains the following: "XRFNAME|SCANS"
Using the member function will fail because it does not take into account the wildcard character "*"
so this list won't work '("*|SCANS" "*|IMAGES" "*|XREF").
Also since xref layers contain character "|" then this list won't work '("SCANS" "IMAGES" "XREF"):
What you should use is the wcmatch function like what you did here:

;; Match XREF file name pattern
(setq skip-xref
(or (wcmatch xref-root "*_24VDG*")
(wcmatch xref-root "*_30VDG*")
(wcmatch xref-root "*_24X36*")
(wcmatch xref-root "*_30X36*")
)
)
So I would add this section:

;; Match Layer name pattern
(setq skip-names
(or (wcmatch upper "*|SCANS")
(wcmatch upper "*|IMAGES")
(wcmatch upper "*|XREF")
)
)
Then the If filter will look like this:

;; Apply command if all filters pass
(if (and
(not skip-names)
; (not (member upper skip-names))
(/= lay-color 200)
(eq lay-plottable :vlax-true)
(not skip-xref)
)
Also instead of using the Layer command to change the transparency, you can use this code:

(progn
(prompt (strcat "\nSetting transparency to 50 for layer: " lname))
; (command "_.-layer" "_tr" "50" lname "")
(setpropertyvalue (tblobjname "layer" lname) "Transparency" 50)
)
Try this revise code to see if it works:

(defun c:XREFTR50 ( / *error* doc layers layer lname upper xref-root
lay-color lay-plottable skip-names split-pos skip-xref )

;; Error handler
(defun *error* (msg)
(prompt (strcat "\nError: " msg))
(princ)
)

(vl-load-com)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
layers (vla-get-Layers doc)
;; skip-names '("*|SCANS" "*|IMAGES" "*|XREF")
;;skip-names '("SCANS" "IMAGES" "XREF")
)

(vlax-for layer layers
(setq lname (vla-get-Name layer))
(if (and lname (= (type lname) 'STR) (vl-string-search "|" lname))
(progn
;; Normalize name
(setq upper (strcase lname))

;; Extract xref-root from "<xref>|<layer>"
; (setq split-pos (vl-string-search "|" lname))
; (setq xref-root (strcase (substr lname 1 split-pos)))

;; Get layer color and plottable
(setq lay-color (vla-get-Color layer))
(setq lay-plottable (vla-get-Plottable layer))

;; Match XREF file name pattern
(setq skip-xref
(or (wcmatch xref-root "*_24VDG*")
(wcmatch xref-root "*_30VDG*")
(wcmatch xref-root "*_24X36*")
(wcmatch xref-root "*_30X36*")
)
)

;; Match Layer name pattern
(setq skip-names
(or (wcmatch upper "*|SCANS")
(wcmatch upper "*|IMAGES")
(wcmatch upper "*|XREF")
)
)

;; Apply command if all filters pass
(if (and
(not skip-names)
; (not (member upper skip-names))
(/= lay-color 200)
(eq lay-plottable :vlax-true)
(not skip-xref)
)
(progn
(prompt (strcat "\nSetting transparency to 50 for layer: " lname))
; (command "_.-layer" "_tr" "50" lname "")
(setpropertyvalue (tblobjname "layer" lname) "Transparency" 50)
)
)
)
)
)

(prompt "\nTransparency update complete.")
(princ)
)

[BlackBox]

Instead of setting the transparency for each-and-every-single applicable layer one-at-a-time, introducing overhead where each call requires a Transaction, simply set them all in one pass (aka one Transaction) by leveraging AutoCAD's native -LAYER Command which was written in C++:



(vl-load-com)

(defun c:XREFTR50 (/ skip *error* layerNames layerName cmdecho)

(setq skip
"*_24VDG*|*,*_30VDG*|*,*_24X36*|*,*_30X36*|*,*|SCANS,*|IMAGES,*|XREF"
)

(defun *error* (msg)
(if cmdecho (setvar 'cmdecho cmdecho))
(cond ((not msg)) ; Normal exit
((member msg '("Function cancelled" "quit / exit abort"))) ; <esc> or (quit)
((princ (strcat "\n** Error: " msg " ** "))) ; Fatal error, display it
)
(princ)
)

(setq layerNames "")

(vlax-for oLayer (vla-get-layers
(vla-get-activedocument
(vlax-get-acad-object)
)
)
(if
(and
(vl-string-search
"|"
(setq layerName (strcase (vla-get-name oLayer)))
)
(not (wcmatch layerName skip))
(/= 200 (vla-get-color oLayer))
(= :vlax-true (vla-get-plottable oLayer))
)
(setq layerNames (strcat layerNames "," layerName))
)
)

(if (/= "" layerNames)
(progn
(setq cmdecho (getvar 'cmdecho))
(setvar 'cmdecho 0)
(command "._-layer" "tr" "50" (vl-string-left-trim "," layerNames) "")
)
)

(*error* nil)
)


HTH

[PaulLi_apa]

Yes that’s a good point to separate layer names with a comma and then run a single layer command operation. But since there are xrefs involved making layer names quite long perhaps adding some kind of mechanism to check the string length to make sure the list of layers doesn’t go beyond 255 characters?

[BlackBox]

Yes that’s a good point to separate layer names with a comma and then run a single layer command operation. But since there are xrefs involved making layer names quite long perhaps adding some kind of mechanism to check the string length to make sure the list of layers doesn’t go beyond 255 characters?

Yikes; I've never worked in an environment with such layer naming conventions, so I've admittedly never hit 255 characters.

I mean, yeah - if someone's result exceeds the 255 (I haven't tested this is actually a limit of -LAYER Command), then the layerNames var would need to be broken out by string length / 255 and trim it by the appropriate ","

[Edit] - if that really does happen, then modify code to first iterate XREFs, those not skipped, simply append "XrefName|*" to layerNames var to account for all of them, then iterate all layers and also skip anything in layerNames var.

[cadd4la]

PaulLi_apa,

I ran your code, and it gave me this "Error: bad argument type: stringp nil"

So, I reviewed your code and made a change; it runs. However, it still listed the XREF layer, but it ran faster than my version.

Original

;; Extract xref-root from "<xref>|<layer>"
; (setq split-pos (vl-string-search "|" lname))
; (setq xref-root (strcase (substr lname 1 split-pos)))

Changed to

;; Extract xref-root from "<xref>|<layer>"
(setq upper (strcase lname))
(setq split-pos (vl-string-search "|" lname))
(setq xref-root (strcase (substr lname 1 split-pos)))

Thanks,

Cadd4la

[cadd4la]

Blackbox,

Thanks for the code, it works great and does what I need without listing all the layers in the XREF files.

Regards,

Cadd4la

[PaulLi_apa]

That's odd because that portion of the code is from what you had posted:

(setq upper (strcase lname))
That line you moved is already there:

[cadd4la]

PaulLi_apa,

Yes, but you canceled them out by putting ; in front of those two lines.

Thanks,

Cadd4la

[PaulLi_apa]

the semicolons only comment out the first line
since there's no semicolon on the second line that line still runs

[PaulLi_apa]

Ok, now I see the two lines you are referring to which I did mistakenly place semicolons in front...
Yes, these semicolons in front of these two lines should not have been placed there.