Author Topic: Anonymous Block  (Read 1692 times)

0 Members and 1 Guest are viewing this topic.

Aldo

  • Newt
  • Posts: 22
Anonymous Block
« on: December 13, 2017, 06:55:02 PM »
Hi guys
I found this routine on the web, to rename anonymous blocks, the problem is that in the case of having more than one block I must run the routine for each of the blocks otherwise it does not work, the help I ask is if there is any way to modify the routine in such a way that allows me to make a multiple selection.
Very grateful for the help.


;===============================================
;    UnAnon.Lsp                                   Jul 05, 1998
;======================================
(princ "\nCopyright (C) 1998, Fabricated Designs, Inc.")
(princ "\nLoading UnAnon v1.0 ")
(setq uan_ nil lsp_file "UnAnon")

;================== For Automated Calling From Another Program =========
(defun uan_auto (ar1) (UnAnon ar1))

;================== Macros =============================================
(defun PDot ()(princ "."))

(PDot);++++++++++++ Set Modes & Error ++++++++++++++++++++++++++++++++++
(defun uan_smd ()
 (SetUndo)
 (setq olderr *error*
      *error* (lambda (e)
                (and (/= e "quit / exit abort")
                     (princ (strcat "\nError: *** " e " *** ")))
                (command "_.UNDO" "_END" "_.U")
                (uan_rmd))
       uan_var '(
  ("CMDECHO"   . 0) ("MENUECHO" . 0) ("MENUCTL"   . 0) ("MACROTRACE" . 0)
  ("OSMODE"    . 0) ("SORTENTS" . 119)("MODEMACRO" . ".")
  ("BLIPMODE"  . 0) ("EXPERT"   . 0) ("SNAPMODE"  . 1) ("PLINEWID"   . 0.0)
  ("ORTHOMODE" . 1) ("GRIDMODE" . 0) ("ELEVATION" . 0) ("THICKNESS"  . 0)
  ("FILEDIA"   . 0) ("FILLMODE" . 0) ("SPLFRAME"  . 0) ("UNITMODE"   . 0)
  ("TEXTEVAL"  . 0) ("ATTDIA"   . 0) ("AFLAGS"    . 0) ("ATTREQ"     . 1)
  ("ATTMODE"   . 1) ("UCSICON"  . 1) ("HIGHLIGHT" . 1) ("REGENMODE"  . 1)
  ("COORDS"    . 2) ("DRAGMODE" . 2) ("DIMZIN"    . 1) ("PDMODE"     . 0)
  ("CECOLOR"   . "BYLAYER") ("CELTYPE" . "BYLAYER")))
 (foreach v uan_var
      (setq m_v (cons (getvar (car v)) m_v)
            m_n (cons (car v) m_n))
      (setvar (car v) (cdr v)))
 (princ (strcat (getvar "PLATFORM") " Release " (substr (ver) 18 2)
   " -  Convert To Anonymous Blocks ....\n"))
 (princ))

(PDot);++++++++++++ Return Modes & Error +++++++++++++++++++++++++++++++
(defun uan_rmd ()
  (setq *error* olderr)
  (mapcar 'setvar m_n m_v)
  (command "_.UNDO" "_END")
  (prin1))

(PDot);++++++++++++ Set And Start An Undo Group ++++++++++++++++++++++++
(defun SetUndo ()
 (and (zerop (getvar "UNDOCTL"))
      (command "_.UNDO" "_ALL"))
 (and (= (logand (getvar "UNDOCTL") 2) 2)
      (command "_.UNDO" "_CONTROL" "_ALL"))
 (and (= (logand (getvar "UNDOCTL") 8) 8)
      (command "_.UNDO" "_END"))
 (command "_.UNDO" "_GROUP"))

(PDot);++++++++++++ Get Entity Name ++++++++++++++++++++++++++++++++++++
(defun GetOne (/ st os)
 (setq os (getvar "SNAPMODE") s nil)
 (setvar "SNAPMODE" 0)
 (while (not st)
        (setq st (ssget)))
 (while (> (sslength st) 1)
        (setq st nil)
        (princ "\nOnly 1 At A Time Please\n")
        (while (not st)
               (setq st (ssget))))
 (setvar "SNAPMODE" os)
 (setq s (ssname st 0)))

(PDot);++++++++++++ Convert An Anonymous Block To Named Block ++++++++++
(defun UnAnon (b / tdef en ed bc bn bd in)          ;Supply ename
  (setq bn "TEMP1" bc 1)
  (while (tblsearch "BLOCK" bn)
         (setq bc (1+ bc) bn (strcat "TEMP" (itoa bc))))
  (and (= (type b) 'ENAME)
       (setq bd (entget b)
             in (cdr (assoc 2 bd))))
  (if (or (not bd)
          (not in)
          (/= "INSERT" (cdr (assoc 0 bd)))
          (/= "*U" (substr in 1 2))
          (= (logand (cdr (assoc 70 (tblsearch "BLOCK" in)))  4)  4)
          (= (logand (cdr (assoc 70 (tblsearch "BLOCK" in))) 16) 16)
          (= (logand (cdr (assoc 70 (tblsearch "BLOCK" in))) 32) 32))
       (progn
         (princ "*** Not An Anonomymous Block *** ")
         (setq bn nil bc nil bd nil in nil b nil)
         (exit)))
  (setq tdef (tblsearch "BLOCK" in)
          en (cdr (assoc -2 tdef))
          ed (entget en))
  (entmake (list (cons 0 "BLOCK")
                 (cons 2 bn)
                 (cons 70 0)
                 (cons 10 (cdr (assoc 10 tdef)))))
  (entmake ed)
  (while (setq en (entnext en))
         (setq ed (entget en))
         (entmake ed))
  (entmake (list (cons 0 "ENDBLK")))
  (setq bd (subst (cons 2 bn) (assoc 2 bd) bd))
  (entmod bd)
  (entupd b)
  (princ (strcat "\n" bn)))

(PDot);************ Main Program ***************************************
(defun uan_ (/ m_v m_n olderr uan_var s)
  (uan_smd)
  (GetOne)
  (UnAnon s)
  (uan_rmd))

(defun c:UnAnonall (/ ss i)
 (setq ss (ssget "X" (list (cons 0 "INSERT")(cons 67 (if (= (getvar "TILEMODE") 1) 0 1)))))
 (and ss
   (setq i (sslength ss))
   (while (not (minusp (setq i (1- i))))
          (setq en (ssname ss i))
          (if (= "*U" (substr (cdr (assoc 2 (entget en))) 1 2))
              (UnAnon en))))
 (prin1))

(PDot);************ Load Program ***************************************
(defun C:UnAnon () (uan_))
(if uan_ (princ "\nUnAnon Loaded\n"))
(prin1)
;================== End Program ========================================

HasanCAD

  • Swamp Rat
  • Posts: 1421
Re: Anonymous Block
« Reply #1 on: December 14, 2017, 03:13:58 AM »
Try out to add this part to the lisp
Code - Auto/Visual Lisp: [Select]
  1. (defun c:UnAnonSel (/ ss i)
  2.  (setq ss (ssget (list (cons 0 "INSERT")(cons 67 (if (= (getvar "TILEMODE") 1) 0 1)))))
  3.  (and ss
  4.    (setq i (sslength ss))
  5.    (while (not (minusp (setq i (1- i))))
  6.           (setq en (ssname ss i))
  7.           (if (= "*U" (substr (cdr (assoc 2 (entget en))) 1 2))
  8.               (UnAnon en))))
  9.  (prin1))

PS:Attached modified lisp New Command line for selection is UnAnonSel

David Bethel

  • Swamp Rat
  • Posts: 656
Re: Anonymous Block
« Reply #2 on: December 14, 2017, 06:10:21 AM »
Wow !  That still comes up every so often !  Even almost 20 years after writing it.

I do need to update that poor thing :roll:

-David
R12 Dos - A2K

David Bethel

  • Swamp Rat
  • Posts: 656
Re: Anonymous Block
« Reply #3 on: December 14, 2017, 06:43:01 AM »
Ok You caught me with a bit of time :

Code - Auto/Visual Lisp: [Select]
  1. ;=======================================================================
  2. ;    UnAnonM.Lsp                                    Dec 12, 2017
  3. ;    Convert Anonymous INSERT Into A Stanard Block - TEMPnnn
  4. ;    Multiple Selections But NOT Multiple Copies Of The INSERT
  5. ;================== Start Program ======================================
  6. (princ "\nCopyright (C) 1990-2017, Fabricated Designs, Inc.")
  7. (princ "\nLoading UnAnonM v1.0 ")
  8. (setq unm_ nil lsp_file "UnAnonM")
  9.  
  10. ;++++++++++++ Set Modes & Error ++++++++++++++++++++++++++++++++++
  11. (defun unm_smd ()
  12.  (SetUndo)
  13.  (setq olderr *error*
  14.       *error* (lambda (msg)
  15.                 (while (> (getvar "CMDACTIVE") 0)
  16.                        (command))
  17.                 (and (/= msg "quit / exit abort")
  18.                      (princ (strcat "\nError: *** " msg " *** ")))
  19.                 (and (= (logand (getvar "UNDOCTL") 8) 8)
  20.                      (command "_.UNDO" "_END" "_.U"))
  21.                 (unm_rmd))
  22.        unm_var '(("SORTENTS"  . 119)
  23.                 ("BLIPMODE"  . 0) ("EXPERT"     . 5)
  24.                 ("SNAPMODE"  . 1) ("COORDS"    . 2)
  25.                 ("ELEVATION" . 0) ("THICKNESS"  . 0)
  26.                 ("UCSICON"   . 1) ("HIGHLIGHT" . 1)
  27.                 ("CELTSCALE" . 1)
  28.                 ("CECOLOR"   . "BYLAYER")
  29.                 ("CELTYPE"   . "BYLAYER")))
  30.  (foreach v unm_var
  31.    (and (getvar (car v))
  32.         (setq unm_rst (cons (cons (car v) (getvar (car v))) unm_rst))
  33.         (setvar (car v) (cdr v))))
  34.  (princ (strcat (getvar "PLATFORM") " Release " (ver)))
  35.  (princ))
  36.  
  37. ;++++++++++++ Return Modes & Error +++++++++++++++++++++++++++++++
  38. (defun unm_rmd ()
  39.   (setq *error* olderr)
  40.   (foreach v unm_rst (setvar (car v) (cdr v)))
  41.   (command "_.UNDO" "_END")
  42.   (prin1))
  43.  
  44. ;++++++++++++ Set And Start An Undo Group ++++++++++++++++++++++++
  45. (defun SetUndo ()
  46.  (and (zerop (getvar "UNDOCTL"))
  47.       (command "_.UNDO" "_ALL"))
  48.  (and (= (logand (getvar "UNDOCTL") 2) 2)
  49.       (command "_.UNDO" "_CONTROL" "_ALL"))
  50.  (and (= (logand (getvar "UNDOCTL") 8) 8)
  51.       (command "_.UNDO" "_END"))
  52.  (command "_.UNDO" "_GROUP"))
  53.  
  54. ;************ Main Program ***************************************
  55. (defun unm_ (/ olderr unm_var unm_rst
  56.               ss i en ed an td fe bc bn fd)
  57.   (unm_smd)
  58.  
  59.   (and (setq ss (ssget (list (cons 0 "INSERT")(cons 2 "`*U*"))))
  60.        (setq i 0)
  61.        (while (setq en (ssname ss i))
  62.               (setq ed (entget en)
  63.                     an (cdr (assoc 2 ed))
  64.                     td (tblsearch "BLOCK" an)
  65.                     fe (cdr (assoc -2 td))
  66.                     bc 1 bn "TEMP1")
  67.                (while (tblsearch "BLOCK" bn)
  68.                       (setq bc (1+ bc) bn (strcat "TEMP" (itoa bc))))
  69.                (princ (strcat "\nProcessing " an "->" bn))
  70.                (setq td (subst (cons 2 bn) (assoc 2 td) td))
  71.                (setq td (subst (cons 70 0) (assoc 70 td) td))
  72.                (entmake td)
  73.                (while fe
  74.                   (setq fd (entget fe))
  75.                   (entmake fd)
  76.                   (setq fe (entnext fe)))
  77.                (entmake (list (cons 0 "ENDBLK")(cons 8 "0")))
  78.                (entmod (subst (cons 2 bn) (assoc 2 ed) ed))
  79.                (entupd en)
  80.                (setq i (1+ i))))
  81.  
  82.   (unm_rmd))
  83.  
  84. ;************ Load Program ***************************************
  85. (defun C:UnAnonM () (unm_))
  86. (if unm_ (princ "\nUnAnonM Loaded\n"))
  87. ;|================== End Program =======================================
  88.  

A lot tighter code than 20 years ago - As Benny Hill would say 'Learning All The Time'

-David
R12 Dos - A2K

Aldo

  • Newt
  • Posts: 22
Re: Anonymous Block
« Reply #4 on: December 14, 2017, 03:31:45 PM »
very grateful, it's just what I needed