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

0 Members and 1 Guest are viewing this topic.

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)