Author Topic: Freeze Object(s)  (Read 10048 times)

0 Members and 1 Guest are viewing this topic.

Birdy

  • Guest
Freeze Object(s)
« on: May 03, 2005, 08:34:13 AM »
Here's a routine I found on the augi site that I can use.
It takes a selection set and puts them on new layers "*-FREEZE"
which are frozen.  Nice, but I'd like to add a fuction to THAW them back to their original state (ie, put 'em back on their original layer), and delete the *-FREEZE layer if nothing is on 'em.
Any takers?  (credit to the swamp will go back to the author)
Code: [Select]
;;; Created by Karl Browning
;;; kbrowning@chasebrass.com
;;; 16 May 2003
;;;
;;; This function is used to select an object(s), figure out what layer it is on,
;;; make a new layer based on the old one with "-Freeze" appended, change the object
;;; to the new layer, then freeze layers *-Freeze. I made this to clean up some vendor
;;; prints without losing the data.
;;;
;;; Feel free to modify the lisp, just send me a copy of it when you are done. ;)

(defun c:FRZOBJ (/ sset counter item LayerName NewLayerName)
  (vl-load-com)
  (initerr) ;Load error trapping
  (setvar "cmdecho" 0)
  (command "undo" "m")
  (setq sset (ssget)) ;get selection set
  (setq counter 0) ;set the counter
  (repeat (sslength sset) ;count number of entities and loop
    (setq item    (ssname sset counter) ;extract the entity name
 item    (vlax-ename->vla-object item)
;convert to a vl object
 LayerName (vla-get-layer item) ;get the object's layer
    ) ;_ end of setq
    (if (= (TBLSEARCH "Layer" (strcat LayerName "-Freeze")) nil)
;check for "layer"-Freeze
      (progn
(setq NewLayerName (strcat LayerName "-Freeze"))
;if not there, create it
(command ".layer" "new" NewLayerName "")
      ) ;_ end of progn
      (setq NewLayerName (strcat LayerName "-Freeze"))
    ) ;_ end of if
    (vla-put-layer item NewLayerName)
    (setq counter (1+ counter))
  ) ;_ end of repeat
  (princ)
  (command ".layer" "freeze" "*-Freeze" "")
  (setq sset nil)
  (reset)
  (princ)
) ;_ end of defun


(defun error ()
  (prompt "\nGlobal Error Trap Loaded")
  (princ)
  )

;;;*=================================================================================

(defun initerr ()
  (setq oldlayer (getvar "clayer")
oldsnap (getvar "osmode")
oldpick (getvar "pickbox")
temperr *error*
*error* trap)
  (princ)
  )

;;;*=================================================================================

(defun trap (errmsg)
  (command nil nil nil)
  (if (not (member errmsg '("console break" "Function Cancelled"))
  )
    (princ (strcat "\nError: " errmsg))
    )
  (command "undo" "b")
  (setvar "clayer" oldlayer)
  (setvar "menuecho" 0)
  (setvar "highlight" 1)
  (setvar "osmode" oldsnap)
  (setvar "pickbox" oldpick)
  (princ "\nError Resetting Environment ")
  (terpri)
  (setq *error* temperr)
  (princ)
  )

;;;*=================================================================================

(defun reset ()
  (setq *error* temperr)
  (setvar "clayer" oldlayer)
  (setvar "menuecho" 0)
  (setvar "highlight" 1)
  (setvar "osmode" oldsnap)
  (setvar "pickbox" oldpick)
  (princ)
  )

;;;*=================================================================================

(princ)

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Freeze Object(s)
« Reply #1 on: May 03, 2005, 08:43:14 AM »
I'd like to help, yet ...

Wouldn't it be more polite to pose this question to the AUGI folk?

If some swamp dude coded up a utility I think it would be more polite if one wanted added functionality to pose the question here, rather than go to AUGI and say "I found this utility at the swamp, can anyone here fix it up?". So to be fair to AUGI I think this should be treated the same way.

Not trying to be confrontational, but not having the benefit of my first coffee yet, this is how this looks to me ... am I wrong?

shrug.mpg
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

Birdy

  • Guest
Freeze Object(s)
« Reply #2 on: May 03, 2005, 08:48:21 AM »
No, not at all wrong.
In fact you're quite right! My apologies.
<OnlyHavingBenefitOfHalfCupSoFar>

Going over there now...

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Freeze Object(s)
« Reply #3 on: May 03, 2005, 08:50:12 AM »
Sorry, didn't mean to chase you way but it does seem the right thing to do.

(Hope birdy comes back).
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

M-dub

  • Guest
Freeze Object(s)
« Reply #4 on: May 03, 2005, 08:51:00 AM »
Quote from: MP
(Hope birdy comes back).


Leave him a trail of bread crumbs! :)

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Freeze Object(s)
« Reply #5 on: May 03, 2005, 08:51:38 AM »
I think Karl Browning should have first right of refusal.
Then come one come all.  :)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

TimSpangler

  • Water Moccasin
  • Posts: 2010
  • CAD Naked!!
Freeze Object(s)
« Reply #6 on: May 03, 2005, 08:53:18 AM »
Birdy,

I can't help you modify the posted routine (I don't have that much time  :D )
But I can offer an alternative.

I found this little baby somewhere.

Found to be a paid app (Sorry for that)

I believe this is kind of what you want it doesn't however create a new layer.
ACA 2015 - Windows 7 Pro
All Comments and Content by TimSpangler, Copyright © 2016

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Freeze Object(s)
« Reply #7 on: May 03, 2005, 08:53:36 AM »
Ding ding ding. I wished Alan posted that before me; that's a better way to say it.
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

Birdy

  • Guest
Freeze Object(s)
« Reply #8 on: May 03, 2005, 08:59:35 AM »
You guys are UNBELIEVABLE!
5 additional replies in the time it took me to log back on to the augi site!
Hip, Hip, yada, yada!

Thanks. I'll continue <------ ereht revo
and give your's a shot Tim.
Donuts all 'round.

daron

  • Guest
Freeze Object(s)
« Reply #9 on: May 03, 2005, 09:48:43 AM »
I'm curious as to how you received that code, Tim. Here's why
Code: [Select]
program created by:
;;; contract cadd
;;; frank zander

That seems to imply he was paid to write it. I could very well be wrong though. Would you care to calm my issues with that code?

TimSpangler

  • Water Moccasin
  • Posts: 2010
  • CAD Naked!!
Freeze Object(s)
« Reply #10 on: May 03, 2005, 10:41:44 AM »
If i am not mistaken (and I could be but I'll look into it more) It was posted on the Autodesk Newsgroups by Contract CADD Group.  Not sure but I'll look closer.

I'll Be right back.
ACA 2015 - Windows 7 Pro
All Comments and Content by TimSpangler, Copyright © 2016

hendie

  • Guest
Freeze Object(s)
« Reply #11 on: May 03, 2005, 10:42:00 AM »
Daron, I think you may be right. I seem to remember the program being offered for $9.99 or something

TimSpangler

  • Water Moccasin
  • Posts: 2010
  • CAD Naked!!
Freeze Object(s)
« Reply #12 on: May 03, 2005, 11:04:54 AM »
Ok I am back.  I couldn't run across the post on the Adesk NG but when I went to the contract cadd site I found that you are correct. It sells for $9.95.  I'll post an alternative.
ACA 2015 - Windows 7 Pro
All Comments and Content by TimSpangler, Copyright © 2016

Birdy

  • Guest
Freeze Object(s)
« Reply #13 on: May 03, 2005, 11:07:22 AM »
I talked to Frank.
They have a "tutorial" on their site that does this via VBA. There is a link to download the code, no strings attached.  Elsewhere on their site, they have a link to purchase the code ($9.95).
No mention of the beta lisp version, but in his words:
"...If your using this program and it is saving you time...  
Buy it.  Sounds like the ethical thing to do...."
to which I wholeheartedly agree.
So, if it'll save us time, we will buy it.
If it doesn't save us time, we'll delete it.

On another note, posted <------ ereht revo,
1hr 40min ago, no replies.  :(

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Freeze Object(s)
« Reply #14 on: May 03, 2005, 11:09:48 AM »
Honestly, it's a joke if that code sells for any amount of money, it is not professionally written and it's a technique has been used by many of us for *years*.

/rant
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

daron

  • Guest
Freeze Object(s)
« Reply #15 on: May 03, 2005, 11:15:08 AM »
jab, jab, sucker punch. Down for the count. hehehe. I've seen worse. Heck, I've written worse and currently use worse that someone got paid to write.

TimSpangler

  • Water Moccasin
  • Posts: 2010
  • CAD Naked!!
Freeze Object(s)
« Reply #16 on: May 03, 2005, 11:44:24 AM »
OK.

Here is essentially the same thing from another author

Code: [Select]
;;; author: mataeux
;;; From autodesk discussion groups
;;; Jan 20, 2005
(defun c:vi (/ *error* ss ss2 ent elist ct)
  (defun *error* (s)
    (setq ct 0)
    (repeat (sslength ss)
      (setq ent (ssname ss ct)
            elist (entget ent)
            ct (1+ ct)
      )
      (entmod (append
                elist'
                ((60 . 1))
              )
      )
    )
    (sssetfirst ss ss)
    (command "._undo" "END")
    (princ)
  )
  (command "._undo" "BEGIN")
  (setq ss (cond
             ((ssget "X" '((60 . 1))))
             ((ssadd))
           )
        ct 0
  )
  (repeat (sslength ss)
    (setq ent (ssname ss ct)
          elist (entget ent)
          ct (1+ ct)
    )
    (entmod (subst' (60 . 0) '(60 . 1) elist))
  )
  (princ)
  (while (progn
           (foreach v (reverse (vports))
             (setvar "CVPORT" (car v))
             (setq ct 0)
             (repeat (sslength ss)
               (redraw (ssname ss ct) 3)
               (setq ct (1+ ct))
             )
           )
           (prompt (strcat "\n" (itoa (sslength ss)) " Invisible Object" (if (=
                                                                                (sslength ss) 1
                                                                             )
                                                                           " is"
                                                                           "s are"
                                                                         ) " highlighted."
                   )
           )
           (setq ss2 (ssget ":S"))
         )
    (setq ct 0)
    (repeat (sslength ss2)
      (setq ent (ssname ss2 ct)
            ct (1+ ct)
      )
      (if (ssmemb ent ss)
        (progn
          (ssdel ent ss)
          (redraw ent 4)
        )
        (ssadd ent ss)
      )
    )
  )
  (*error* ())
)


This one was free for the taking (to the best of my knowledge)

 :P
ACA 2015 - Windows 7 Pro
All Comments and Content by TimSpangler, Copyright © 2016

Birdy

  • Guest
Freeze Object(s)
« Reply #17 on: May 03, 2005, 12:01:47 PM »
DING! DING! DING!
We have a winner!
Score:
Swamp: 86 views, 16 replies, elapsed time: 3:10

Augi: 11 views, 0 replies, elapsed time: 2:25 (and counting)

Thanks Tim... and ALL of you'uns.

Credit to all the swampies.  Homemade Gin for everyone!

Whoops... one just came in <------ ereht revo, will have to have a look-see.
(swamp still wins though.)

Birdy

  • Guest
Freeze Object(s)
« Reply #18 on: May 03, 2005, 12:34:40 PM »
FWIW, here's what I got from Augi site.  This seems to work pretty good, but  I think I like the visibility route a little better.  It has a higher "cool" factor.
BTW, I first tried to email the author....bounced. :(
Code: [Select]
;;; Created by Karl Browning
;;; kbrowning@chasebrass.com
;;; 16 May 2003
;;;
;;; This function is used to select an object(s), figure out what layer it is on,
;;; make a new layer based on the old one with "-Freeze" appended, change the object
;;; to the new layer, then freeze layers *-Freeze. I made this to clean up some vendor
;;; prints without losing the data.
;;;
;;; Feel free to modify the lisp, just send me a copy of it when you are done. ;)
(defun c:la->freeze (/ sset counter item LayerName NewLayerName)
  (vl-load-com)
  (initerr) ;Load error trapping
  (setvar "cmdecho" 0)
  (command "undo" "m")
  (setq sset (ssget))   ;get selection set
  (setq counter 0)   ;set the counter
  (repeat (sslength sset)  ;count number of entities and loop
(setq item (ssname sset counter) ;extract the entity name
   item (vlax-ename->vla-object item)
;convert to a vl object
   LayerName (vla-get-layer item) ;get the object's layer
) ;_ end of setq
(if (= (TBLSEARCH "Layer" (strcat LayerName "-Freeze")) nil)
;check for "layer"-Freeze
 (progn
 (setq NewLayerName (strcat LayerName "-Freeze"))
;if not there, create it
 (command ".layer" "new" NewLayerName "")
 ) ;_ end of progn
 (setq NewLayerName (strcat LayerName "-Freeze"))
) ;_ end of if
(vla-put-layer item NewLayerName)
(setq counter (1+ counter))
  ) ;_ end of repeat
  (princ)
  (princ
(strcat (itoa counter) " items moved to frozen layer(s). ")
  )
  (command ".layer" "freeze" "*-Freeze" "")
  (setq sset nil)
  (reset)
  (princ)
) ;_ end of defun

(defun error ()
  (prompt "\nGlobal Error Trap Loaded")
  (princ)
)
;;;*==============================================  ===================================
(defun initerr ()
  (setq oldlayer (getvar "clayer")
 oldsnap  (getvar "osmode")
 oldpick  (getvar "pickbox")
 temperr  *error*
 *error*  trap
  )
  (princ)
)
;;;*==============================================  ===================================
(defun trap (errmsg)
  (command nil nil nil)
  (if (not (member errmsg '("console break" "Function Cancelled"))
 )
(princ (strcat "\nError: " errmsg))
  )
  (command "undo" "b")
  (setvar "clayer" oldlayer)
  (setvar "menuecho" 0)
  (setvar "highlight" 1)
  (setvar "osmode" oldsnap)
  (setvar "pickbox" oldpick)
  (princ "\nError Resetting Environment ")
  (terpri)
  (setq *error* temperr)
  (princ)
)
;;;*==============================================  ===================================
(defun reset ()
  (setq *error* temperr)
  (setvar "clayer" oldlayer)
  (setvar "menuecho" 0)
  (setvar "highlight" 1)
  (setvar "osmode" oldsnap)
  (setvar "pickbox" oldpick)
  (princ)
)
;;;*==============================================  ===================================
;;; LA->THAW added by L. Gordon 5/3/05
;;; Uses existing error trapping
(defun c:LA->THAW (/ counter sset item LayerName NewLayerName)
  (vl-load-com)
  (initerr) ;Load error trapping
  (setvar "cmdecho" 0)
  (command "undo" "m")
  (setq counter 0) ;set the counter
  (setq sset (ssget "X" '((8 . "*-FREEZE"))))  ;get selection set
  (if sset
(progn
 (repeat (sslength sset)
 (setq item (ssname sset counter)
;extract the entity name
  item (vlax-ename->vla-object item)
;convert to a vl object
  LayerName (vla-get-layer item) ;get the object's layer
  NewLayerName (substr LayerName 1 (- (strlen LayerName) 7))
  ; create destination layer name
 ) ;_ end of setq
 (if (tblsearch "LAYER" NewLayerName) ; Be sure it exists
   (vla-put-layer item NewLayerName) ; and put object there
 )
 (setq counter (1+ counter))
 ) ; end of repeat
 (setvar "CMDECHO" 0)
 (command "_PURGE" "la" "*-Freeze" "N")
 (setvar "CMDECHO" 1)
 (princ (strcat (itoa counter)
  " items restored to original layer(s). "
 )
 )
)
  )
  (reset)
  (princ)
)
(princ)

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Freeze Object(s)
« Reply #19 on: May 03, 2005, 12:53:28 PM »
Quick and dirty --

Code: [Select]
(defun c:HideEm ( / hideit ss i )

    (defun hideit ( ename )
        (vl-catch-all-apply
            ;;  honor locked layer status
           '(lambda ( )
                (vla-put-visible
                    (vlax-ename->vla-object ename)
                    :vlax-false
                )
            )
        )
    )

    (if (setq ss (ssget))
        (repeat (setq i (sslength ss))
            (hideit
                (ssname ss
                    (setq i (1- i))
                )
            )
        )
    )

    (princ)

)

and ...

Code: [Select]
(defun c:ShowEm ( / showit ss i )

    (defun showit ( ename )
        (vl-catch-all-apply
            ;;  honor locked layer status
           '(lambda ( / object )
                (vla-put-visible
                    (setq object
                        (vlax-ename->vla-object ename)
                    )
                    :vlax-true
                )
                (vla-update object)
            )
        )
    )

    (if (setq ss (ssget "x" '((60 . 1))))
        (repeat (setq i (sslength ss))
            (showit
                (ssname ss
                    (setq i (1- i))
                )
            )
        )
    )

    (princ)

)
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

VVA

  • Newt
  • Posts: 166
Re: Freeze Object(s)
« Reply #20 on: June 02, 2011, 05:49:52 AM »
A little edit version of Aleksandr Smirnov (ASMI)
Makes objects temporarily invisible and visible return of all or some
Code: [Select]
(defun c:invis(/ errCount wMode objSet showset actDoc *error*)
;; ==================================================================== ;;
;;                                                                      ;;
;;  INVIS.LSP - Makes objects temporarily invisible and                 ;;
;;              visible return of all or some                           ;;
;;                                                                      ;;
;; ==================================================================== ;;
;;                                                                      ;;
;;  Command(s) to call: INVIS                                           ;;
;;                                                                      ;;
;; ==================================================================== ;;
;;                                                                      ;;
;;  THIS PROGRAM AND PARTS OF IT MAY REPRODUCED BY ANY METHOD ON ANY    ;;
;;  MEDIUM FOR ANY REASON. YOU CAN USE OR MODIFY THIS PROGRAM OR        ;;
;;  PARTS OF IT ABSOLUTELY FREE.                                        ;;
;;                                                                      ;;
;;  THIS PROGRAM PROVIDES 'AS IS' WITH ALL FAULTS AND SPECIFICALLY      ;;
;;  DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY OR FITNESS        ;;
;;  FOR A PARTICULAR USE.                                               ;;
;;                                                                      ;;
;; ==================================================================== ;;
;;                                                                      ;;
;;  V1.1, 11th Apr 2005, Riga, Latvia                                   ;;
;;  © Aleksandr Smirnov (ASMI)                                          ;;
;;  For AutoCAD 2000 - 2008 (isn't tested in a next versions)           ;;
;;                                                                      ;;
;;http://www.cadtutor.net/forum/showthread.php?43876-AsmiTools          ;;
;; ==================================================================== ;;
;;                                                                      ;;
;;  V1.2, 02 June 2011, Minsk, Belarus                                  ;;
;;  © Vladimir Azarko (VVA)                                             ;;
;;  For AutoCAD 2000 - 2011 (isn't tested in a next versions)           ;;
;; Add mode "Show some object"                                          ;;
;;                                                                      ;;
;;http://www.cadtutor.net/forum/showthread.php?59655                    ;;
;; ==================================================================== ;;
;;                                                                      ;;

  (vl-load-com)

  (defun put_Visible_Prop(Object Flag)
    (if
      (vl-catch-all-error-p
(vl-catch-all-apply
  'vla-put-visible (list Object Flag)))
          (setq errCount(1+ errCount))
    ); end if
  (princ)
  ); end of put_Visible_Prop

  (defun Set_to_List(SelSet)
    (mapcar 'vlax-ename->vla-object
                    (vl-remove-if 'listp
                     (mapcar 'cadr(ssnamex SelSet))))
  ); end of Set_to_List

  (defun errMsg()
    (if(/= 0 errCount)
  (princ(strcat ", " (itoa errCount)
" were on locked layer."))
      "."
  ); end if
    ); end of errMsg
 
(setq actDoc(vla-get-ActiveDocument
      (vlax-get-Acad-object))
      errCount 0); end setq
  (vla-StartUndoMark actDoc)
(initget "Visible Invisible Show" 1)
  (setq wMode
    (getkword "\nMake objects [Visible all/Invisible/Show some invisible objects]: "))
  (cond
    ((and
       (= wMode "Visible")
       (setq objSet(ssget "_X" '((60 . 1))))
       ); end and
      (setq objSet(Set_to_List objSet))
   (mapcar
    '(lambda(x)(put_Visible_Prop x :vlax-true))objSet)
    (princ
      (strcat "\n<< "
      (itoa(-(length objSet)errCount))
   " now visible" (errMsg) " >>"))
      );_ # condition
    ((and
       (= wMode "Show")
       (setq objSet(ssget "_X" '((60 . 1))))
       ); end and
      (setq objSet(Set_to_List objSet))
   (mapcar
    '(lambda(x)(put_Visible_Prop x :vlax-true))objSet)
    (princ
      (strcat "\n<< "
      (itoa(-(length objSet)errCount))
   " now visible" (errMsg) " >>"))
     (princ "\nSelect objects to show")
     (if (setq showset (ssget "_:L"))
       (progn
(setq showset(Set_to_List showset))
(foreach item showset
   (setq objSet (vl-remove item objSet))
   )
  (mapcar
    '(lambda(x)(put_Visible_Prop x :vlax-false))objSet)
)
       )
      );_ # condition
    (t
      (if(not(setq objSet(ssget "_I")))
(setq objSet(ssget))
); end if
      (if objSet
(progn
  (setq objSet(Set_to_List objSet))
  (mapcar
    '(lambda(x)(put_Visible_Prop x :vlax-false))objSet)
    (princ
      (strcat "\n<< "
      (itoa(-(length objSet)errCount))
   " now invisible" (errMsg) " >>"))
  ; end if
); end progn
); end if
       )
    )
  (vla-EndUndoMark actDoc)
(princ)
); end of c:invis
(princ "\n[Info] http://www.cadtutor.net/forum/showthread.php?59655 [Info]")
(princ "\n[Info] Type INVIS to make objects invisible or visible. [Info]")(princ)