Topic: Get and set layer and entity transparency using LISP

[BlackBox]

The following was inspired by Adam's code in this ADNDevBlog article: Get and set layer and entity transparency using LISP

While certainly not as inspiring as the offering that Tony provided in the comments of that ADNDevBlog article, I thought to post these for Adam's consideration since the code he did post in his article only answered half of the original request, and given the article's title including both Layer and Entity transparency.


In any event, here are my meager offerings for others' consideration, in the context of Adam's original ADNDevBlog article:

Code - Auto/Visual Lisp: [Select]

1. (vl-load-com)
2.  
3. (defun GetLayerTransparency (layerName / layer transparency)
4.   (if (setq layer (tblobjname "layer" layerName))
5.     (if (setq transparency
6.                (cdr
7.                  (assoc
8.                    1071
9.                    (cdar
10.                      (cdr
11.                        (assoc -3
12.                               (entget layer '("AcCmTransparency"))
13.                        )
14.                      )
15.                    )
16.                  )
17.                )
18.         )
19.       (fix (- 100 (/ (lsh (lsh transparency 24) -24) 2.55)))
20.       0
21.     )
22.   )
23. )
24. (defun SetLayerTransparency (layerName transparency / *error* oldCmdecho oldNomutt ok)
25.  
26.   (defun *error* (msg)
27.     (and oldCmdecho (setvar 'cmdecho oldCmdecho))
28.     (and oldNomutt (setvar 'nomutt oldNomutt))
29.     (cond ((not msg))                                                   ; Normal exit
30.           ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
31.           ((princ (strcat "\n** Error: " msg " ** ")))                  ; Fatal error, display it
32.     )
33.     ok
34.   )
35.  
36.   (if (and (tblsearch "layer" layerName)
37.            (<= 0 transparency 90)
38.            (setq oldCmdecho (getvar 'cmdecho))
39.            (setvar 'cmdecho 0)
40.            (setq oldNomutt (getvar 'nomutt))
41.            (setvar 'nomutt 1)
42.       )
43.     (setq ok
44.            (vl-cmdf "._-layer" "transparency" transparency layerName ""
45.                    )
46.     )
47.   )
48.   (*error* nil)
49. )
50.  
51.  
52.  
53. (defun GetEntityTransparency (entity / typ transparency)
54.   (cond ((= 'VLA-OBJ (setq typ (type entity)))
55.          (vla-get-entitytransparency entity)
56.         )
57.         ((= 'ENAME typ)
58.          (if (setq transparency (cdr (assoc 440 (entget entity))))
59.            (fix (- 100 (/ (lsh (lsh transparency 24) -24) 2.55)))
60.            0
61.          )
62.         )
63.   )
64. )
65. (defun SetEntityTransparency (entity transparency / typ)
66.   (if (or (and (= 'STR (setq typ (type transparency)))
67.                (= "BYLAYER" (strcase transparency))
68.           )
69.           (and (= 'INT typ) (<= 0 transparency 90))
70.       )
71.      (cond ((= 'VLA-OBJECT (setq typ (type entity)))
72.             (not (vla-put-entitytransparency entity transparency))
73.            )
74.            ((= 'ENAME typ)
75.             (SetEntityTransparency
76.               (vlax-ename->vla-object entity)
77.               transparency
78.             )
79.            )
80.      )
81.   )
82. )
83.  

Cheers

[Lee Mac]

Code - Auto/Visual Lisp: [Select]

1. (lsh (lsh transparency 24) -24)

Why the shift of 24 bits?

The bit to be removed is the 25^th bit (33554432), hence for 32-bit integers, only a 7-bit shift is required to remove all bits above and including the 25^th, and one could not argue that the code is accounting for 64-bit integers, since this would require a shift of 39 bits.

However, to remove the single 25^th bit, rather than shifting bits back & forth, an alternative solution is to simply mask the unrequired bit, e.g.:

Code - Auto/Visual Lisp: [Select]

1. (logand <DXF-440> -33554433)

[BlackBox]

Code - Auto/Visual Lisp: [Select]

1. (lsh (lsh transparency 24) -24)

Why the shift of 24 bits?

The bit to be removed is the 25^th bit (33554432), hence for 32-bit integers, only a 7-bit shift is required to remove all bits above and including the 25^th, and one could not argue that the code is accounting for 64-bit integers, since this would require a shift of 39 bits.

However, to remove the single 25^th bit, rather than shifting bits back & forth, an alternative solution is to simply mask the unrequired bit, e.g.:

Code - Auto/Visual Lisp: [Select]

1. (logand <DXF-440> -33554433)

Thanks for pointing that out, Lee.

I'm sure that makes perfect sense to some, I don't really understand that part well myself, as I only streamlined the steps I could from Adam's original code as stated above.

Please feel free to further critique, offer a simpler adaptation, etc. as it only reinforces the point I originally made (in my ADNDevBlog article comment), that the code was more complicated than it needed to be.

Cheers

[Lee Mac]

Please feel free to further critique, offer a simpler adaptation, etc. as it only reinforces the point I originally made (in my ADNDevBlog article comment), that the code was more complicated than it needed to be.

I would personally make the following changes:

Code - Auto/Visual Lisp: [Select]

1. (defun getlayertransparency ( lay / trn )
2.     (if (setq lay (tblobjname "LAYER" lay))
3.         (if (setq trn (cdr (assoc 1071 (cdadr (assoc -3 (entget lay '("AcCmTransparency")))))))
4.             (fix (- 100 (/ (logand trn -33554433) 2.55)))
5.             0
6.         )
7.     )
8. )

Note (cdar (cdr ... )) = (cdadr ... ).

Code - Auto/Visual Lisp: [Select]

1. (defun setlayertransparency ( lay trn / cmd rtn )
2.     (if (and (tblsearch "LAYER" lay) (<= 0 trn 90))
3.         (progn
4.             (setq cmd (getvar 'cmdecho))
5.             (setvar 'cmdecho 0)
6.             (setq rtn (vl-cmdf "_.-layer" "_TR" trn lay ""))
7.             (setvar 'cmdecho cmd)
8.             rtn
9.         )
10.     )
11. )

I saw no reason for the error handler and no reason to change NOMUTT

Code - Auto/Visual Lisp: [Select]

1. (defun getentitytransparency ( ent )
2.     (cond
3.         (   (= 'vla-object (type ent))
4.             (vla-get-entitytransparency ent)
5.         )
6.         (   (= 'ename (type ent))
7.             (getentitytransparency (vlax-ename->vla-object ent))
8.         )
9.     )
10. )

Seems more consistent with your setentitytransparency function.

[BlackBox]

Well done, Lee... As always. 

[Lee Mac]

Cheers dude, I haven't ventured into entity transparency before, so this was refreshing 

[BlackBox]

Cheers dude, I haven't ventured into entity transparency before, so this was refreshing 

Nor had I, until reading that article, and it got me thinking where I could put it to use... When I saw the original code, and all of the unnecessary conversion to/from Vla-Object & Ename, I thought I'd take a go at it.

The only real issue I've encountered was in processing large drawings of entities (not using the code posted here)... LISP is terribly slow in this process as compared to .NET, which is a shame... Otherwise, I might find ways to use this (conceptually) more for my work.

In any event, I always appreciate your feedback, Lee.

Cheers

[roy_043]

Why use recursion?

Code - Auto/Visual Lisp: [Select]

1. (defun getentitytransparency (ent)
2.   (vla-get-entitytransparency (if (= (type ent) 'ename) (vlax-ename->vla-object ent) ent))
3. )

[BlackBox]

Well done. :thumbsup:

[Lee Mac]

Why use recursion?

Code - Auto/Visual Lisp: [Select]

1. (defun getentitytransparency (ent)
2.   (vla-get-entitytransparency (if (= (type ent) 'ename) (vlax-ename->vla-object ent) ent))
3. )

I guess you have extra argument checking without too much extra code, e.g.:

Passing argument not of entity/vla-object data type:
Lee Mac - nil
Roy - error

vlax-ename->vla-object returns nil (i.e. entity is erased):
Lee Mac - nil
Roy - error

The alternative to account for the above without using recursion could be:

Code - Auto/Visual Lisp: [Select]

1. (defun getentitytransparency ( ent )
2.     (if (or (= 'vla-object (type ent))
3.             (and (= 'ename (type ent))
4.                  (setq ent (vlax-ename->vla-object ent))
5.             )
6.         )
7.         (vla-get-entitytransparency ent)
8.     )
9. )

[roy_043]

@Lee Mac:
If you want this argument checking you should be consistent and also check for a deleted object.

[alanjt]

Wouldn't this be the easier solution (slight mod of your original)?

Code: [Select]

(defun getentitytransparency (ent)
  (cond
    ((= 'vla-object (type ent))
     (vla-get-entitytransparency ent)
    )
    ((= 'ename (type ent))
     (vla-get-entitytransparency (vlax-ename->vla-object ent))
    )
  )
)
With your recursion method, you are checking the entity type 3 times, if it's an ename.

[PrinceLISPalot]

I would personally make the following changes:

Code - Auto/Visual Lisp: [Select]

1. (defun getlayertransparency ( lay / trn )
2.     (if (setq lay (tblobjname "LAYER" lay))
3.         (if (setq trn (cdr (assoc 1071 (cdadr (assoc -3 (entget lay '("AcCmTransparency")))))))
4.             (fix (- 100 (/ (logand trn -33554433) 2.55)))
5.             0
6.         )
7.     )
8. )

Playing with this function I noticed that some layers would return a transparency setting of 100 instead of 0. It seems that in some cases AcCmTransparency is available but is set = 0. I adjusted the code to add a check that trn was also greater than 0.

Code - Auto/Visual Lisp: [Select]

1. (defun getlayertransparency ( lay / trn )
2.     (if (setq lay (tblobjname "LAYER" lay))
3.         (if (and (setq trn (cdr (assoc 1071 (cdadr (assoc -3 (entget lay '("AcCmTransparency"))))))) (> trn 0))
4.             (fix (- 100 (/ (logand trn -33554433) 2.55)))
5.             0
6.         )
7.     )
8. )

Also find that if the Layer Transparency is set = 40 the function returns 39.

For reference attach a drawing created in AutoCAD 2018 used to test with.

[Lee Mac]

Many thanks for your testing, feedback, and additions 

This should correct the 39/40 issue (which arises from the inaccuracy of doubles at the limit of precision):

Code - Auto/Visual Lisp: [Select]

1. (defun getlayertransparency ( lay / trn )
2.     (if (setq lay (tblobjname "LAYER" lay))
3.         (if (and (setq trn (cdr (assoc 1071 (cdadr (assoc -3 (entget lay '("AcCmTransparency"))))))) (< 0 trn))
4.             (fix (- 100 (/ (logand trn (~ 33554432)) 2.55) -1e-8))
5.             0
6.         )
7.     )
8. )

[PrinceLISPalot]

I realised that you could use getpropertyvalue and setpropertyvalue functions to get and set transparency

Code - Auto/Visual Lisp: [Select]

1. ; GetEntityTransparency
2. ; Gets the Transparency for an entity
3. ; returns
4. ; -1 = ByLayer
5. ; -2 = ByBlock
6. ; 0 - 90 where Transparency has been explicitly set
7. (defun GetEntityTransparency (entity)
8.   (getpropertyvalue entity "Transparency")
9. )
10.  
11. ; SetEntityTransparency
12. ; sets the Transparency for an entity
13. ; -1 = ByLayer
14. ; -2 = ByBlock
15. ; 0 - 90 for explicitly set transparency
16. ; returns the value set if successful, nil otherwise
17. ; Note. This function doesn't work as expected in BricsCAD V23.
18.  
19. (defun SetEntityTransparency (entity trn)
20.         (cond ((<= -2 trn 90)
21.                         (setpropertyvalue entity "Transparency" trn)
22.                         (getpropertyvalue entity "Transparency")
23.                         )
24.         )
25. )

These functions will also work with layers and explains why sometimes a layer with 0 transparency returns a value when querying "AcCmTransparency". It would seem a new layer in AutoCAD has transparency set to -1 by default, which is ByLayer. If you subsequently change the transparency for the layer, then set back to 0 then that is what it is set to i.e. it doesn't get set back to -1. In BricsCAD the transparency looks to be 0 by default.


It's a bit redundant but functions to get an set layer transparency using this approach would be

Code - Auto/Visual Lisp: [Select]

1. ; GetLayerTransparency
2. ; Returns the given layers transparency value
3. ; will return a value between
4. ; 0 - 90
5.  
6. (defun getlayertransparency (lay / trn )
7.     (if (setq lay (tblobjname "LAYER" lay))
8.        (if (< (setq trn (getpropertyvalue lay "Transparency")) 0)
9.                 0
10.                 trn
11.            )
12.     )
13. )
14.  
15. ; SetLayerTransparency
16. ; Sets the given layers transparency
17. ; valid value
18. ; 0 - 90
19. ; Note. This function doesn't work as expected in BricsCAD V23.
20.  
21. (defun SetLayerTransparency (lay trn)
22.     (cond ((and (tblsearch "LAYER" lay) (<= 0 trn 90))
23.                         (setq lay (tblobjname "LAYER" lay))
24.                         (setpropertyvalue lay "Transparency" trn)
25.                         (getpropertyvalue lay "Transparency")
26.                  )
27.         )
28. )

Setting transparency this way doesn't work as expected in BricsCAD. It looks like it may be expecting the value in the form of "AcCmTransparency", which would require conversion of the % based figure.

I guess this proves things are easier if you use a MAC