TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: QuestionEverything on October 10, 2016, 09:15:35 AM

Title: Vanilla LISP alternative?
Post by: QuestionEverything on October 10, 2016, 09:15:35 AM
Hi,
I am trying to get rid of the activex stuff here:
Code: [Select]
_$ (setq lname "Layer4")
"Layer4"
_$ (setq lobj (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) lname))
#<VLA-OBJECT IAcadLayer 00000098f7c52778>
_$ (vlax-dump-object lobj)
; IAcadLayer: A logical grouping of data, similar to transparent acetate overlays on a drawing
; Property values:
;   Application (RO) = #<VLA-OBJECT IAcadApplication 00007ff792299110>
;   Description = ""
;   Document (RO) = #<VLA-OBJECT IAcadDocument 00000098eb3bd978>
;   Freeze = -1
;   Handle (RO) = "238"
;   HasExtensionDictionary (RO) = 0
;   LayerOn = 0
;   Linetype = "Continuous"
;   Lineweight = -3
;   Lock = -1
;   Material = "Global"
;   Name = "Layer4"
;   ObjectID (RO) = 42
;   ObjectName (RO) = "AcDbLayerTableRecord"
;   OwnerID (RO) = 43
;   PlotStyleName = "Normal"
;   Plottable = -1
;   TrueColor = #<VLA-OBJECT IAcadAcCmColor 00000098ebdd8870>
;   Used (RO) = -1
;   ViewportDefault = 0
T
_$ (setq lent (tblobjname "LAYER" lname))
<Entity name: 7ff79120b280>
_$ (setq ldata (entget lent))
((-1 . <Entity name: 7ff79120b280>) (0 . "LAYER") (330 . <Entity name: 7ff791203820>) (5 . "238") (100 . "AcDbSymbolTableRecord") (100 . "AcDbLayerTableRecord") (2 . "Layer4") (70 . 5) (62 . -104) (6 . "Continuous") (290 . 1) (370 . -3) (390 . <Entity name: 7ff7912038f0>) (347 . <Entity name: 7ff791203cc0>) (348 . <Entity name: 0>))
_$ (setq flg (cdr (assoc 70 ldata)))
5
_$ (if (= (vla-get-lock lobj) :vlax-true) (vla-put-lock lobj :vlax-false))
nil
_$ (vlax-dump-object lobj)
; IAcadLayer: A logical grouping of data, similar to transparent acetate overlays on a drawing
; Property values:
;   Application (RO) = #<VLA-OBJECT IAcadApplication 00007ff792299110>
;   Description = ""
;   Document (RO) = #<VLA-OBJECT IAcadDocument 00000098eb3bd978>
;   Freeze = -1
;   Handle (RO) = "238"
;   HasExtensionDictionary (RO) = 0
;   LayerOn = 0
;   Linetype = "Continuous"
;   Lineweight = -3
;   Lock = 0
;   Material = "Global"
;   Name = "Layer4"
;   ObjectID (RO) = 42
;   ObjectName (RO) = "AcDbLayerTableRecord"
;   OwnerID (RO) = 43
;   PlotStyleName = "Normal"
;   Plottable = -1
;   TrueColor = #<VLA-OBJECT IAcadAcCmColor 00000098ebdd8ab0>
;   Used (RO) = -1
;   ViewportDefault = 0
T
_$  (setq flg (cdr (assoc 70 ldata)))
5
_$
But the question is how perform this subst alternative, just like (vla-get/put-Lock) without affecting layer's frozen status? (in the above, I change the lock status, but the flag stays at 5 value).
For short, I mean:
Code: [Select]
(setq lname "Layer4")
(setq lobj (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) lname))
(if (= (vla-get-lock lobj) :vlax-true) (vla-put-lock lobj :vlax-false))
How to continue this to achieve the result in the ^^above^^ code:
Code: [Select]
(setq lname "Layer4")
(setq lent (tblobjname "LAYER" lname))
(setq ldata (entget lent))
(setq flg (cdr (assoc 70 ldata)))
; ... whats next ? / check if locked, if so - then unlock and vice-versa
Title: Re: Vanilla LISP alternative?
Post by: gile on October 10, 2016, 10:09:58 AM
Hi,

Using DXF:
Code - Auto/Visual Lisp: [Select]
  1. (defun locklayer (layerName / layer elst dxf70)
  2.   (if (setq layer (tblobjname "layer" layerName))
  3.     (progn
  4.       (setq elst (entget layer))
  5.       (setq dxf70 (assoc 70 elst))
  6.       (entmod (subst (cons 70 (logior (cdr dxf70) 4)) dxf70 elst))
  7.     )
  8.   )
  9. )
  10.  
  11. (defun unlocklayer (layerName / layer elst dxf70)
  12.   (if (setq layer (tblobjname "layer" layerName))
  13.     (progn
  14.       (setq elst (entget layer))
  15.       (setq dxf70 (assoc 70 elst))
  16.       (entmod (subst (cons 70 (logand (cdr dxf70) (~ 4))) dxf70 elst))
  17.     )
  18.   )
  19. )

Using MAC ActiveX alternative (http://docs.autodesk.com/ACDMAC/2012/ENU/filesALRMac/GUID-ED406069-97F9-4552-BBEF-9A02D06E6C1-203.htm) (works also on Windows since A2012):
Code - Auto/Visual Lisp: [Select]
  1. (defun locklayer (layerName / layer)
  2.   (if (setq layer (tblobjname "layer" layerName))
  3.     (setpropertyvalue layer "IsLocked" 1)
  4.   )
  5. )
  6.  
  7. (defun unlocklayer (layerName / layer)
  8.   (if (setq layer (tblobjname "layer" layerName))
  9.     (setpropertyvalue layer "IsLocked" 0)
  10.   )
  11. )
Title: Re: Vanilla LISP alternative?
Post by: QuestionEverything on October 10, 2016, 02:10:51 PM
Merci, gile!
After revising your DXF codes I came up with this:
Code: [Select]
(defun islayerlocked (layerName / layer elst dxf70)
        (and
(setq layer (tblobjname "layer" layerName))
(setq elst (entget layer))
(setq dxf70 (assoc 70 elst))
(= 4 (logand 4 (cdr dxf70)))
)
)
Title: Re: Vanilla LISP alternative?
Post by: gile on October 10, 2016, 02:55:04 PM
Perhaps I misunderstood what you wanted to do.

The codes I posted lock (or unlock) the layer whatever its actual state, IOW you do not need to check if the layer is locked or not.

Locking:
Code - Auto/Visual Lisp: [Select]
  1. (logior 4 1) ; dxf70 = 1 (frozen, unlocked)
returns 5 (frozen, locked)

Code - Auto/Visual Lisp: [Select]
  1. (logior 4 5) ; dxf70 = 5 (frozen, locked)
also returns 5  (frozen, locked)

Unlocking:
Code - Auto/Visual Lisp: [Select]
  1. (logand (~ 4) 5) ; dxf70 = 5 (frozen, locked)
returns 1  (frozen, unlocked)

Code - Auto/Visual Lisp: [Select]
  1. (logand (~ 4) 1) ; dxf70 = 1 (frozen, unlocked)
also returns 1  (frozen, unlocked)

Bitwise operations on binary flags is a basic of programming.

Anyway, the "new" AutoLISP functions (https://www.theswamp.org/index.php?topic=39259.msg444841#msg444841) make things simpler.
Title: Re: Vanilla LISP alternative?
Post by: QuestionEverything on October 10, 2016, 03:37:08 PM
Sorry, I hope this is clear enough:

Code: [Select]
(while (setq ld (tblnext "LAYER" (not ld)))
(setq dxf70 (cdr (assoc 70 ld)))
(setq dxf2 (cdr (assoc 2 ld)))
(if (= 4 (logand 4 dxf70)) ; here I check if its locked
(setq LstLocked (cons dxf2 lst))
)
(if (= 1 (logand 1 dxf70)) ; here I check if its frozen
(setq LstFrozen (cons dxf2 lst))
)
)
; Unlock and thaw all layers:
(mapcar 'unlocklayer LstLocked)
(mapcar 'thawlayer LstFrozen)
; Do things in the code
; Restore original lock and frozen state:
(mapcar 'locklayer LstLocked)
(mapcar 'freezelayer LstFrozen)


; The subfunctions:
(defun locklayer (layerName / layer elst dxf70)
  (if (setq layer (tblobjname "layer" layerName))
    (progn
      (setq elst (entget layer))
      (setq dxf70 (assoc 70 elst))
      (entmod (subst (cons 70 (logior (cdr dxf70) 4)) dxf70 elst))
)
)
)
(defun unlocklayer (layerName / layer elst dxf70)
  (if (setq layer (tblobjname "layer" layerName))
    (progn
      (setq elst (entget layer))
      (setq dxf70 (assoc 70 elst))
      (entmod (subst (cons 70 (logand (cdr dxf70) (~ 4))) dxf70 elst))
)
)
)
(defun freezelayer (layerName / layer elst dxf70)
  (if (setq layer (tblobjname "layer" layerName))
    (progn
      (setq elst (entget layer))
      (setq dxf70 (assoc 70 elst))
      (entmod (subst (cons 70 (logior (cdr dxf70) 1)) dxf70 elst))
)
)
)
(defun thawlayer (layerName / layer elst dxf70)
  (if (setq layer (tblobjname "layer" layerName))
    (progn
      (setq elst (entget layer))
      (setq dxf70 (assoc 70 elst))
      (entmod (subst (cons 70 (logand (cdr dxf70) (~ 1))) dxf70 elst))
)
)
)
I try to "collect" the original status/state of every layer, then unlock and thaw all of them, then reset their status/state.
I am aware of these AutoLISP functions, but I remember once I tried the set/get propertyvalue and didn't work out. But anyway I am more interestend in the DXF approach.
Title: Re: Vanilla LISP alternative?
Post by: gile on October 10, 2016, 04:52:44 PM
Ok.

Just for fun, a "all in one" function which stores the locked and frozen layers lists inside itself:

Code - Auto/Visual Lisp: [Select]
  1. (defun-q UnlockAndUnfreeze
  2.          (flag / lay elst dxf70 locked forzen)
  3.          (setq locked nil
  4.                frozen nil
  5.          )
  6.          (if flag
  7.            (while (setq lay (tblnext "layer" (not lay)))
  8.              (setq lay   (tblobjname "layer" (cdr (assoc 2 lay)))
  9.                    elst  (entget lay)
  10.                    dxf70 (cdr (assoc 70 elst))
  11.              )
  12.              (and (= 4 (logand 4 dxf70))
  13.                   (setq locked (cons lay locked))
  14.                   (entmod (subst (cons 70 (- dxf70 4)) (cons 70 dxf70) elst))
  15.              )
  16.              (and (= 1 (logand 1 dxf70))
  17.                   (setq frozen (cons lay frozen))
  18.                   (entmod (subst (cons 70 (- dxf70 1)) (cons 70 dxf70) elst))
  19.              )
  20.            )
  21.            (progn
  22.              (foreach l locked
  23.                (and
  24.                  (setq elst (entget l))
  25.                  (setq dxf70 (cdr (assoc 70 elst)))
  26.                  (entmod (subst (cons 70 (+ dxf70 4)) (cons 70 dxf70) elst))
  27.                )
  28.              )
  29.              (foreach l frozen
  30.                (and
  31.                  (setq elst (entget l))
  32.                  (setq dxf70 (cdr (assoc 70 elst)))
  33.                  (entmod (subst (cons 70 (+ dxf70 1)) (cons 70 dxf70) elst))
  34.                )
  35.              )
  36.              (setq locked nil
  37.                    frozen nil
  38.              )
  39.            )
  40.          )
  41.          (setq UnlockAndUnfreeze
  42.                 (vl-list*
  43.                   (car UnlockAndUnfreeze)
  44.                   (list 'setq 'locked (list 'quote locked) 'frozen (list 'quote frozen))
  45.                   (cddr UnlockAndUnfreeze)
  46.                 )
  47.          )
  48.          lst
  49. )

(UnlockAndUnfreeze T) unlock and unfreeze all layers;
(UnlockAndUnfreeze nil) relock and refreeze previously loked and frozen layers
Title: Re: Vanilla LISP alternative?
Post by: QuestionEverything on October 10, 2016, 05:35:09 PM
Thank you so much, gile! :D
Title: Re: Vanilla LISP alternative?
Post by: Grrr1337 on October 11, 2016, 03:21:01 PM
Sorry for bumping this thread, but I think my issue is somewhat related:
Code: [Select]
; another way to omit locked or frozen layers, without using ":L" ssget mode:
; Here we iterate thru the layer definitions (the other way is to iterate thru enames of the SS and check their layer's lock/freeze status - but it may be slower)
(defun C:test ( / ld FrozenOrLockedLayers SSX ftLst )

(while (setq ld (tblnext "LAYER" (not ld)))
(if (or (= 4 (logand 4 (cdr (assoc 70 ld)))) (= 1 (logand 1 (cdr (assoc 70 ld)))) )
(setq FrozenOrLockedLayers (cons (cdr (assoc 2 ld)) FrozenOrLockedLayers))
)
)

(if
(setq SSX
(ssget "_X"
(setq ftLst
(list
(cons -4 "<AND")
(if FrozenOrLockedLayers
(progn
(cons -4 "<NOT")
(cons -4 "<OR")
(mapcar '(lambda (x)  (cons 8 x) ) (acad_strlsort FrozenOrLockedLayers))
(cons -4 "OR>")
(cons -4 "NOT>")
)
(cons 8 "*")
)
(if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model"))
(cons -4 "AND>")
)
)
)
)
(sssetfirst nil SSX)
)
(princ)
);| defun |; (vl-load-com) (princ)
Why the above code won't work? I've tried several ways and it still fails while using the ssget logical operators.
Title: Re: Vanilla LISP alternative?
Post by: ribarm on October 11, 2016, 04:15:12 PM
IMO the problem with your version is the fact that you are supplying multiple DXF 8 code specifications inside (ssget) filter, and knowing that DXF 8 code accepts only string value as (cdr) dotted pair specification, I may think that (ssget) function will therefore fail to process multiple DXF 8 code specifications... So as (cdr) value must be string and valid one, (ssget) function should work correctly if specification is supplied likewise (wcmatch) pattern string specification...

So something like this may be more desired and although untested, should be correct way of specifying (ssget) filter...

Code: [Select]
; another way to omit locked or frozen layers, without using ":L" ssget mode:
; Here we iterate thru the layer definitions (the other way is to iterate thru enames of the SS and check their layer's lock/freeze status - but it may be slower)
(defun C:test ( / ld ThawedOrUnLockedLayersString ThawedOrUnLockedLayers SSX ftLst )

  (while (setq ld (tblnext "LAYER" (not ld)))
    (if (not (or (= 4 (logand 4 (cdr (assoc 70 ld)))) (= 1 (logand 1 (cdr (assoc 70 ld))))))
      (setq ThawedOrUnLockedLayers (cons (cdr (assoc 2 ld)) ThawedOrUnLockedLayers))
    )
  )

  (if ThawedOrUnLockedLayers
    (progn
      (setq ThawedOrUnLockedLayersString "")
      (foreach x (reverse (acad_strlsort ThawedOrUnLockedLayers))
        (setq ThawedOrUnLockedLayersString (strcat ThawedOrUnLockedLayersString x ","))
      )
      (setq ThawedOrUnLockedLayersString (vl-string-right-trim "," ThawedOrUnLockedLayersString))
    )
  )
  (if
    (and
      ThawedOrUnLockedLayers
      (setq SSX
        (ssget "_X"
          (setq ftLst
            (list
              (cons -4 "<AND")
              (cons 8 ThawedOrUnLockedLayersString)
              (if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model"))
              (cons -4 "AND>")
            )
          )
        )
      )
    )
    (sssetfirst nil SSX)
  )
  (princ)
);| defun |;

This is just my attempt, but if I was to code for thawed and unlocked layers, I would for sure use :
Code: [Select]
(if (cadr (sssetfirst nil (ssget "_A" ... )))
  (sssetfirst nil (ssget "_:L"))
  nil
)
Of course I would make sure that at least one layer is unlocked and thawed and has an entity that's possible to select before applying such routine that uses this shortcut snippet...
Title: Re: Vanilla LISP alternative?
Post by: Grrr1337 on October 11, 2016, 05:05:02 PM
Hi Marko,
Thanks for the help, however your suggestion omits only the first layer in the ThawedOrUnLockedLayersString, and includes the other locked/frozen layers, I.e.: "~LAYER1,LAYER2,LAYER3"
Only "LAYER1" is omited from the selection, and "LAYER2" and "LAYER3" are included.
So maybe my question was how to properly construct this logical operator filter list, and after few tries I found that append was the answer:
Code: [Select]
; another way to omit locked or frozen layers, without using ":L" ssget mode:
; Here we iterate thru the layer definitions (the other way is to iterate thru enames of the SS and check their layer's lock/freeze status - but it may be slower)
(defun C:test ( / ld FrozenOrLockedLayers UnFrozenUnLockedLayerExist ftLst)

  (while (setq ld (tblnext "LAYER" (not ld)))
    (if (or (= 4 (logand 4 (cdr (assoc 70 ld)))) (= 1 (logand 1 (cdr (assoc 70 ld)))) )
      (setq FrozenOrLockedLayers (cons (cdr (assoc 2 ld)) FrozenOrLockedLayers))
(setq UnFrozenUnLockedLayerExist 'T)
)
)

(if UnFrozenUnLockedLayerExist
(if
(setq SSX
(ssget "_X"
(setq ftLst
(if FrozenOrLockedLayers
(append
(list (cons -4 "<AND"))
(mapcar '(lambda (x) (cons 8 (strcat "~" x))) FrozenOrLockedLayers)
(list (if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model")))
(list (cons -4 "AND>"))
)
(append
(list (cons 8 "*"))
(list (if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model")))
)
)
)
)
)
(sssetfirst nil SSX)
)
)
  (princ)
);| defun |; (vl-load-com) (princ)
I've tested this code and seems to work properly (you might remember these alternatives we were thinking, for ":L-I" ":L-X" where Roy was involved).
Thanks again for pointing me in the right direction. :)
Title: Re: Vanilla LISP alternative?
Post by: ribarm on October 11, 2016, 05:43:42 PM
I've modified my example few times, so you are right if you saw previous postings, but I think this is all complication - you can for sure use snippet as shortcut - unless you think this is faster and more reliable. If so then I disagree... I didn't test it, but IMO there is no need for making sub functions when you can do it in 3 lines right away while coding and for speed I still don't want to make false statements, but both things for sure are iterating through database, it's just the feeling I and others I suppose think that no evident proof can be concluded when (ssget "_:L") is an issue - implied selection like (ssget "_I") would never be useful if it's not fast - faster then cycling through pickset, so by my hunch I say that (ssget "_:L") may behave similar and that means faster then pure iteration through database... And now you are not iterating through it, but you are supplying another filter to (ssget) excluding locked and frozen layers, so in this case this is very similar and I think that no one can for sure tell what method is faster and more reliable, but I am sure that no one want to make routine larger then if it's not 100% sure that it's necessity...
Title: Re: Vanilla LISP alternative?
Post by: gile on October 11, 2016, 06:23:14 PM
Code - Auto/Visual Lisp: [Select]
  1. (defun c:test (/ ld layers)
  2.   (setq layers "")
  3.   (while (setq ld (tblnext "LAYER" (not ld)))
  4.     (if (zerop (logand 5 (cdr (assoc 70 ld))))
  5.       (setq layers (strcat (cdr (assoc 2 ld)) "," layers))
  6.     )
  7.   )
  8.   (sssetfirst nil (ssget "_X" (list (cons 410 (getvar 'ctab)) (cons 8 layers))))
  9.   (princ)
  10. )
Title: Re: Vanilla LISP alternative?
Post by: roy_043 on October 12, 2016, 03:35:21 AM
@Grrr1337:
In the code for ftLst in your last post '((-4 . "<AND")) and '((-4 . "AND>")) can obviously be removed. Just compare the first and the second append section.
Title: Re: Vanilla LISP alternative?
Post by: Grrr1337 on October 12, 2016, 11:38:16 AM
Thanks for the additional help guys,
I'll try to practice more with these SSGET logical operators. Because I still wasn't sure which one of these would work:
Code: [Select]
; Omit LAYER1, LAYER2 and LAYER3, they are locked/frozen
(ssget "_X" ; #1
(list
(-4 . "<NOT")
(-4 . "<OR")
(8 . "LAYER1")
(8 . "LAYER2")
(8 . "LAYER3")
(-4 . "OR>")
(-4 . "NOT>")
)
)

(ssget "_X" ; #2
(list
(-4 . "<NOT")
(-4 . "<OR")
(8 . "LAYER1,LAYER2,LAYER3")
(-4 . "OR>")
(-4 . "NOT>")
)
)
Before Marko hinted me with the solution of the "~" prefix.
Title: Re: Vanilla LISP alternative?
Post by: ronjonp on October 12, 2016, 11:51:03 AM
This should do the same:
Code - Auto/Visual Lisp: [Select]
  1. (ssget "_X" '((8 . "~LAYER[1-3]")))
WCMATCH Reference (http://help.autodesk.com/view/ACD/2016/ENU/?guid=GUID-EC257AF7-72D4-4B38-99B6-9B09952A53AD)
Title: Re: Vanilla LISP alternative?
Post by: ScottMC on October 21, 2021, 12:08:00 PM
ronjonp, another late arrival but looked around and haven't found a lisp to isolate in cycle, each layer. Usually don't have many layers but it would be nice to temporarily view each. Thanks
Title: Re: Vanilla LISP alternative?
Post by: steve.carson on October 21, 2021, 02:56:11 PM
Sounds like you want to "laywalk". It's a command.

HTH


Steve