Author Topic: Deleting subentities in a block  (Read 1818 times)

0 Members and 1 Guest are viewing this topic.

Giuseppe Beatrice

  • Newt
  • Posts: 43
Deleting subentities in a block
« on: May 03, 2019, 05:59:29 AM »
Hello to Swamp members.
I have a block definition with more 'MTEXT subentities with value "" (see attached file, I don't remember why and when I have performed such stupid operations), and I want to eliminate that useless subentities, that cause an exagerate "minimum enclosed box".
I have proved to perform a function constructed on the basis of one similar, designed to modify subentities and
posted by Andrea in https://www.theswamp.org/index.php?topic=28154.msg337414#msg337414
Unfortunately it doesn't work.
Please, can someone help me? Thanks in advance.

Code - Auto/Visual Lisp: [Select]
  1. (defun EL_MTEXTBLOCK  (/ eBlockSel              ; Block selection
  2.                     lInsertData         ; Entity data
  3.                     sBlockName          ; Block name
  4.                     lBlockData          ; Entity data
  5.                     eSubEntity          ; Sub-entity name
  6.                     lSubData            ; Sub-entity data
  7.                     iCount              ; Counter
  8.                     blk§
  9.                     )
  10.   ;; Redefine error handler
  11.   (setq d_#error *error*
  12.         *error*  D_FB_ERROR) ;_ end setq
  13.   ;; Set up environment
  14.   (setq #sysvars (#SAVESYSVARS (list "cmdecho")))
  15.   (setvar "cmdecho" 0)
  16.   (command "._undo" "_group")
  17.   ;; Get block from user and make sure it's an INSERT type
  18.   (if (setq eBlockSel (entsel "\nSelect block to change :"))
  19.     (progn (if (setq lInsertData (entget (setq blk§ (car eBlockSel))))
  20.              (if (= (cdr (assoc 0 lInsertData)) "INSERT")
  21.                (setq sBlockName (cdr (assoc 2 lInsertData)))
  22.                (progn (alert "Entity selected is not a block!") (exit)) ;_ end progn
  23.                ) ;_ end if
  24.              (progn (alert "Invalid Block Selection!") (exit)) ;_ end progn
  25.              ) ;_ end if
  26.            ;; Get block info from the block table
  27.            (setq lBlockData (tblsearch "BLOCK" sBlockName)
  28.                  eSubEntity (cdr (assoc -2 lBlockData))) ;_ end setq
  29.            ;; Make sure block is not an Xref
  30.            (if (not (assoc 1 lBlockData))
  31.              (progn (princ "\nProcessing block: ")
  32.                     (princ sBlockName)
  33.                     (princ "\nUpdating blocks sub-entities. . .")
  34.                     ;; Parse through all of the blocks sub-entities
  35.                     (while eSubEntity
  36.                       (princ " .")
  37.                       (setq lSubData (entget eSubEntity))
  38.                       (if (and (= (cdr (assoc 0 lSubData)) "MTEXT") (= (cdr (assoc 1 lSubData)) "")) ;_
  39.                         (progn (entdel eSubEntity)))                 
  40.                       (setq eSubEntity (entnext eSubEntity)) ; get next sub entity
  41.                       )                 ; end while
  42.                     ;; Update attributes
  43.                     (IDC_FB_UPDATTRIBS)) ; end progn
  44.              (alert "XREF selected. Not updated!")) ; end if
  45.            )                            ; end progn
  46.     (alert "Nothing selected."))        ; end if
  47.   (IDC_RESTORESYSVARS)
  48.   (princ "\nDone!")
  49.   (setq *error* d_#error)
  50.   (princ))
  51.  
  52. (defun IDC_FB_UPDATTRIBS  ()
  53.   ;; Update any attribute definitions
  54.   (setq iCount 0)
  55.   (princ "\nUpdating attributes. . .")
  56.   (if (setq ssInserts (ssget "x"
  57.                              (list (cons 0 "INSERT") (cons 66 1) (cons 2 sBlockName)) ;_ end list
  58.                              ) ;_ end ssget
  59.             ) ;_ end setq
  60.     (repeat (sslength ssInserts)
  61.       (setq eBlockName (ssname ssInserts iCount))
  62.       (if (setq eSubEntity (entnext eBlockName))
  63.         (setq lSubData (entget eSubEntity)
  64.               eSubType (cdr (assoc 0 lSubData))) ;_ end setq
  65.         ) ;_ end if
  66.       (while (or (= eSubType "ATTRIB") (= eSubType "SEQEND"))
  67.         ;; Update layer property
  68.         (if (assoc 8 lSubData)
  69.           (progn (setq lSubData (subst (cons 8 "0") (assoc 8 lSubData) lSubData) ;_ end subst
  70.                        ) ;_ end setq
  71.                  (entmod lSubData)) ;_ end progn
  72.           ) ;_ end if
  73.         ;; Update the linetype property
  74.         (if (assoc 6 lSubData)
  75.           (progn (setq lSubData (subst (cons 6 "BYBLOCK") (assoc 6 lSubData) lSubData) ;_ end subst
  76.                        ) ;_ end setq
  77.                  (entmod lSubData)) ;_ end progn
  78.           (entmod (append lSubData (list (cons 6 "BYBLOCK"))))) ;_ end if
  79.         ;; Update the color property
  80.         (if (assoc 62 lSubData)
  81.           (progn (setq lSubData (subst (cons 62 0) (assoc 62 lSubData) lSubData) ;_ end subst
  82.                        ) ;_ end setq
  83.                  (entmod lSubData)) ;_ end progn
  84.           (entmod (append lSubData (list (cons 62 0))))) ;_ end if
  85.         (if (setq eSubEntity (entnext eSubEntity))
  86.           (setq lSubData (entget eSubEntity)
  87.                 eSubType (cdr (assoc 0 lSubData))) ;_ end setq
  88.           (setq eSubType nil)) ;_ end if
  89.         )                               ; end while
  90.       (setq iCount (1+ iCount)))        ; end repeat
  91.     )                                   ; end if
  92.   (command "_.regen"))                  ; end defun
  93.  
  94.                                         ;*******************************************************************************
  95.                                         ; Function to save a list of system variables
  96.                                         ;*******************************************************************************
  97. (defun #SAVESYSVARS  (lVarList / sSystemVar)
  98.   (mapcar '(lambda (sSystemVar)
  99.              (setq lSystemVars
  100.                     (append lSystemVars (list (list sSystemVar (getvar sSystemVar)))) ;_ end append
  101.                    ) ;_ end setq
  102.              ) ;_ end lambda
  103.           lVarList) ;_ end mapcar
  104.   lSystemVars) ;_ end defun
  105.                                         ;*******************************************************************************
  106.                                         ; Function to restore a list of system variables
  107.                                         ;*******************************************************************************
  108. (defun IDC_RESTORESYSVARS  ()
  109.   (mapcar '(lambda (sSystemVar) (setvar (car sSystemVar) (cadr sSystemVar))) ;_ end lambda
  110.           #SYSVARS) ;_ end mapcar
  111.   ) ;_ end defun
  112.                                         ;*******************************************************************************
  113.                                         ; Error Handler
  114.                                         ;*******************************************************************************
  115. (defun D_FB_ERROR  (msg)
  116.   (princ "\nError occurred in the Fix Block routine...")
  117.   (princ "\nError: ")
  118.   (princ msg)
  119.   (setq *error* d_#error)
  120.   (if *error*
  121.     (*error* msg)) ;_ end if
  122.   (command)
  123.   (if (/= msg "quit / exit abort")
  124.     (progn (command "._undo" "_end") (command "._u")) ;_ end progn
  125.     ) ;_ end if
  126.   (IDC_RESTORESYSVARS)
  127.   (princ)) ;_ end defun
  128.  

ronjonp

  • Needs a day job
  • Posts: 7526
Re: Deleting subentities in a block
« Reply #1 on: May 03, 2019, 09:30:34 AM »
Maybe this?
Code - Auto/Visual Lisp: [Select]
  1. (defun c:foo nil
  2.     (vlax-for b a
  3.       (and (vlax-property-available-p b 'textstring)
  4.            (vlax-write-enabled-p b)
  5.            (= "" (vl-string-left-trim " " (vla-get-textstring b)))
  6.            (print (vla-get-objectname b))
  7.            (vla-delete b)
  8.       )
  9.     )
  10.   )
  11.   (princ)
  12. )

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

Giuseppe Beatrice

  • Newt
  • Posts: 43
Re: Deleting subentities in a block
« Reply #2 on: May 03, 2019, 11:14:03 AM »
ronjonp, you are a champion!!
I don't understand very much of the code you have posted, due to my little knowledge of visual lisp, but it works fine.
I have only added condition to distinguish Mtext from attribute, cause your function erased attribute definition too.
Code - Auto/Visual Lisp: [Select]
  1. (defun c:foo  nil
  2.         (vlax-for b  a
  3.           (and (vlax-property-available-p b 'textstring)
  4.                (vlax-write-enabled-p b)
  5.                (= "" (vl-string-left-trim " " (vla-get-textstring b)))
  6.  
  7.                (= (vla-get-objectname b) "AcDbMText")
  8.                
  9.                (print (vla-get-objectname b))
  10.                (vla-delete b)
  11.                )))
  12.       (princ))
  13.  
Thank you a lot.

ronjonp

  • Needs a day job
  • Posts: 7526
Re: Deleting subentities in a block
« Reply #3 on: May 03, 2019, 11:36:35 AM »
Glad you got it working to your needs :)

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC