TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: BlackBox on May 02, 2013, 09:04:01 PM

Title: Get and set layer and entity transparency using LISP
Post by: BlackBox on May 02, 2013, 09:04:01 PM
The following was inspired by Adam's code in this ADNDevBlog article: Get and set layer and entity transparency using LISP (http://adndevblog.typepad.com/autocad/2013/04/get-and-set-layer-and-entity-transparency-using-lisp.html)

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]
  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
Title: Re: Get and set layer and entity transparency using LISP
Post by: Lee Mac on May 03, 2013, 08:28:53 AM
Quote from: BlackBox on May 02, 2013, 09:04:01 PM
Code - Auto/Visual Lisp: [Select]
  1. (lsh (lsh transparency 24) -24)

Why the shift of 24 bits?

The bit to be removed is the 25th bit (33554432), hence for 32-bit integers, only a 7-bit shift is required to remove all bits above and including the 25th, 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 25th 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)
Title: Re: Get and set layer and entity transparency using LISP
Post by: BlackBox on May 03, 2013, 09:19:38 AM
Quote from: Lee Mac on May 03, 2013, 08:28:53 AM
Quote from: BlackBox on May 02, 2013, 09:04:01 PM
Code - Auto/Visual Lisp: [Select]
  1. (lsh (lsh transparency 24) -24)

Why the shift of 24 bits?

The bit to be removed is the 25th bit (33554432), hence for 32-bit integers, only a 7-bit shift is required to remove all bits above and including the 25th, 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 25th 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
Title: Re: Get and set layer and entity transparency using LISP
Post by: Lee Mac on May 03, 2013, 10:15:23 AM
Quote from: BlackBox on May 03, 2013, 09:19:38 AM
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.
Title: Re: Get and set layer and entity transparency using LISP
Post by: BlackBox on May 03, 2013, 12:03:19 PM
Well done, Lee... As always.  :-)
Title: Re: Get and set layer and entity transparency using LISP
Post by: Lee Mac on May 03, 2013, 03:48:11 PM
Cheers dude, I haven't ventured into entity transparency before, so this was refreshing  8-)
Title: Re: Get and set layer and entity transparency using LISP
Post by: BlackBox on May 03, 2013, 03:52:04 PM
Quote from: Lee Mac on May 03, 2013, 03:48:11 PM
Cheers dude, I haven't ventured into entity transparency before, so this was refreshing  8-)

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
Title: Re: Get and set layer and entity transparency using LISP
Post by: roy_043 on May 04, 2013, 02:39:07 AM
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. )
Title: Re: Get and set layer and entity transparency using LISP
Post by: BlackBox on May 04, 2013, 03:45:25 AM
Well done. :thumbsup:
Title: Re: Get and set layer and entity transparency using LISP
Post by: Lee Mac on May 04, 2013, 07:51:03 AM
Quote from: roy_043 on May 04, 2013, 02:39:07 AM
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. )
Title: Re: Get and set layer and entity transparency using LISP
Post by: roy_043 on May 06, 2013, 06:20:33 AM
@Lee Mac:
If you want this argument checking you should be consistent and also check for a deleted object.
Title: Re: Get and set layer and entity transparency using LISP
Post by: alanjt on May 06, 2013, 09:44:22 AM
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.
Title: Re: Get and set layer and entity transparency using LISP
Post by: JasonB on August 24, 2023, 05:58:59 PM
Quote from: Lee Mac on May 03, 2013, 10:15:23 AM

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.
Title: Re: Get and set layer and entity transparency using LISP
Post by: Lee Mac on August 25, 2023, 06:03:59 AM
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. )
Title: Re: Get and set layer and entity transparency using LISP
Post by: JasonB on August 28, 2023, 02:24:54 AM
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  :-D
Title: Re: Get and set layer and entity transparency using LISP
Post by: cadpoobah on March 08, 2024, 10:56:31 PM
Can this be mod'd to apply the layer transparency property as a vp override?