hello every one . Please review and help

May 8

I found this lisp on the forum .

This lisp removes block and deletes object.

Thanks to those who understand the chip lisp to help remove an object from a block without deleting the object.

thank you so much for this help.

(defun c:removblock (/ ActDoc BlkCol Sel Ent)
; Erase object selected from block, in block collection, so all blocks will update.

(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(vla-EndUndoMark Actdoc)
(vla-StartUndoMark ActDoc)
(setq BlkCol (vla-get-Blocks ActDoc))
(setvar "errno" 0)
(while (not (equal (getvar "errno") 52))
 (if
  (and
   (setq Sel (nentsel "\n Select nested object to erase from block: "))
   (> (length Sel) 2)
   (not
    (vl-position
     nil
     (mapcar
      '(lambda (x / BlkName BlkObj)
       (setq BlkName (cdr (assoc 2 (entget x))))
       (and
        (not (vl-catch-all-error-p (setq BlkObj (vl-catch-all-apply 'vla-Item (list BlkCol Blkname)))))
        (= (vla-get-IsXref BlkObj) :vlax-false)
        (= (vla-get-IsLayout BlkObj) :vlax-false)
       )
      )
      (last Sel)
     )
    )
   )
   (/= (cdr (assoc 0 (entget (setq Ent (car Sel))))) "ATTRIB")
  )
  (progn
   (vla-Delete (vlax-ename->vla-object Ent))
   (vla-Regen ActDoc acActiveViewport)
  )
  (prompt "\n Object selected can not be erased with this command.")
 )
)
(vla-EndUndoMark ActDoc)
(princ)
)

Edited May 8 by SLW210
Added Code Tags!!

May 8

If i understand correctly, you want to remove the nested block without deleting the parent block is it?

See if this helps.

May 8

thank you @nod684 remove object from block but keep object not in block (instead of deleting object like lisp)

May 8

In the future please use Code Tags for your Code! (<> in the editor toolbar)

It would be great if you posted a link to where you found the code.

May 8

Can you post an example drawing (before/after)?

May 9

thank you @SLW210

please see attach file ! thank you

AAAA.dwg

May 9

You can use REFEDIT>REFSET>REM>REFCLOSE to do the same thing.

May 10

thank you @SLW210i know that ! but i want to use lisp to do it faster

May 11

That's not an easy task for me.

If time allows next week, I'll give it a try.

May 11

Hi
It doesn't seem very difficult.
If you already have code that deletes the object from the block you're interested in, what you can do is use another code before it extracts that object.

May 11

Ncopy Express Tool (if you have Express Tools) will copy it (it has a few prompts). But then, you have to run the delete LISP.

What I tried for using NCopy in a LISP had hiccups (from what I quickly looked into, many have had problems with NCopy in a LISP), like I stated, NCopy has a few prompts as well.

But, for speed, REFEDIT>REFSET>REM>REFCLOSE is probably just as quick if not quicker, I actually use -REFEDIT.

In order to be a quicker alternative, it needs just a click or 2.

I can do it with Text/Mtext, lines and other objects that have a single point to use, polylines are a struggle for me.

I actually have one, but the polyline shows up in another area of the drawing. I need to study more on this aspect of polylines.

I was just using the original for Text/Mtext copy and added the removal from LeeMac.

See new code...

May 11

If you don't have anything better to use to extract the nested entity, you can use this:

(defun GLV_ncopy (/ lse df lne lemk x)
  (setq lse (entget (car (setq le (entsel "\nSelect nested entity..."))))
        df (assoc 10 lse)
        lne (entget (car (nentselp (cadr le))))
        lemk (mapcar '(lambda(x) (if (= (car x) 10) (list 10 (+ (cadr x) (cadr df)) (+ (caddr x) (caddr df))) x)) lne)
	x (entmake lemk)
  )
  le
)

May 29

These work on your test drawing...

All credit to Lee Mac for the solution (plus Gile, Doug Wilson and Vladimir Nesterovsky)

;;; Remove object from block and keep it, update all the block instances.
;;;
;;; https://www.cadtutor.net/forum/topic/97778-hello-every-one-please-review-and-help/#findComment-671730
;;;
;;; By SLW210 (a.k.a. Steve Wilson)
;;;
;;;_____________________________________________________________________________________________________________________________
;;;                                                                                                                             |
;;; Might be messy, I started with something I had for copying an object from a block, still in progress (CopObj.lsp).          |
;;;                                                                                                                             |
;;; Added the delete from LeeMac. https://www.cadtutor.net/forum/topic/38670-delete-entity-in-nested-block/#findComment-315220  |
;;;                                                                                                                             |
;;; Updated with information from Lee Mac's response to a thread... See below                                                   |
;;;                                                                                                                             |
;;; All of the heavy lifting done by Lee Mac, Gile, Doug Wilson and Vladimir Nesterovsky, hopefully I didn't make it too messy. |
;;;                                                                                                                             |
;;;_____________________________________________________________________________________________________________________________|
;;;
;;;###############################################################################################################################
;;; From LeeMac
;;; https://www.cadtutor.net/forum/topic/63984-getting-a-point-of-an-entity-inside-a-block-as-wcs-coordinates/#findComment-527265
;;; Getting a point of an entity inside a block as WCS coordinates
;;;
;;;###############################################################################################################################

;;; Matrix Transpose  -  Doug Wilson
;;; Args: m - nxn matrix

(defun trp (m) (apply 'mapcar (cons 'list m)))

;;; Matrix x Matrix  -  Vladimir Nesterovsky
;;; Args: m,n - nxn matrices

(defun mxm (m n) ((lambda (a) (mapcar '(lambda (r) (mxv a r)) m)) (trp n)))

;;; Matrix x Vector  -  Vladimir Nesterovsky
;;; Args: m - nxn matrix, v - vector in R^n

(defun mxv (m v) (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m))

;;; RefGeom (gile)
;;; Returns a list whose first item is a 3x3 transformation matrix and
;;; second item the object insertion point in its parent (xref, block or space)

(defun refgeom (ent / ang enx mat ocs) 
  (setq enx (entget ent)
        ang (cdr (assoc 50 enx))
        ocs (cdr (assoc 210 enx))
  )
  (list 
    ;; transformation matrix
    (setq mat (mxm 
                ;; OCS to WCS
                (mapcar '(lambda (v) (trans v 0 ocs t)) 
                        '((1.0 0.0 0.0)
                          (0.0 1.0 0.0)
                          (0.0 0.0 1.0)
                         )
                )
                ;; rotation * scale
                (mxm 
                  (list 
                    (list (cos ang) (- (sin ang)) 0.0)
                    (list (sin ang) (cos ang) 0.0)
                    '(0.0 0.0 1.0)
                  )
                  (list 
                    (list (cdr (assoc 41 enx)) 0.0 0.0)
                    (list 0.0 (cdr (assoc 42 enx)) 0.0)
                    (list 0.0 0.0 (cdr (assoc 43 enx)))
                  )
                )
              )
    )
    ;; offset vector (insertion point minus origin of block * matrix)
    (mapcar 
      '-
      (trans (cdr (assoc 10 enx)) ocs 0)
      (mxv mat (cdr (assoc 10 (tblsearch "block" (cdr (assoc 2 enx))))))
    )
  )
)

(defun transform-entity-by-ref (edata mat vec) 
  (mapcar 
    (function 
      (lambda (pair) 
        (if 
          (and (numberp (car pair)) 
               (member (car pair) '(10 11 12 13))
          )
          (cons (car pair) (mapcar '+ (mxv mat (cdr pair)) vec))
          pair
        )
      )
    )
    edata
  )
)

(defun copy-entity-from-block (blkname realEnt mat vec) 
  (cond 
    ((wcmatch (cdr (assoc 0 (entget realEnt))) "POLYLINE")
     ;; Handle old-style polylines
     (progn 
       (while (and realEnt (/= (cdr (assoc 0 (entget realEnt))) "SEQEND")) 
         (setq edata (entget realEnt))
         (setq edata (transform-entity-by-ref edata mat vec))
         (entmake edata)
         (setq realEnt (entnext realEnt))
       )
       ;; Make SEQEND
       (entmake (entget realEnt))
     )
    )

    (T
     ;; Other entity types including LWPOLYLINE, LINE, CIRCLE, etc.
     (setq edata (entget realEnt))
     (setq edata (transform-entity-by-ref edata mat vec))
     (entmake edata)
    )
  )
)
;;;###############################################################################################################################

(defun c:ROB (/ blkRef blkName blkDef blkRefEnt selEnt blkDefEnt mat vec foundEnt 
              pickEnt
             ) 
  (vl-load-com)
  (princ "\nSelect block reference that contains the object.")
  (setq blkRef (car (entsel "\nSelect block reference: ")))

  (if (and blkRef (= (cdr (assoc 0 (entget blkRef))) "INSERT")) 
    (progn 
      (setq blkRefEnt (entget blkRef))
      (setq blkName (cdr (assoc 2 blkRefEnt)))
      (princ (strcat "\nYou selected block: " blkName))

      ;; Select object from block definition
      (setq blkDef (tblobjname "BLOCK" blkName))
      (princ "\nNow select an object inside the block (it will be matched by handle).")
      (setq pickEnt (car (nentsel "\nSelect object inside the block: ")))
      (if (not pickEnt) 
        (progn (princ "\nInvalid selection.") (exit))
      )

      (setq pickHandle (cdr (assoc 5 (entget pickEnt))))
      (setq blkDefEnt (entnext blkDef))
      (setq foundEnt nil)

      ;; Search block definition for entity with same handle
      (while (and blkDefEnt (not foundEnt)) 
        (if (= (cdr (assoc 5 (entget blkDefEnt))) pickHandle) 
          (setq foundEnt blkDefEnt)
          (setq blkDefEnt (entnext blkDefEnt))
        )
      )

      (if (not foundEnt) 
        (progn (princ "\nEntity not found in block definition.") (exit))
      )

      ;; Get transformation matrix and offset vector from refgeom
      (setq mat (car (refgeom blkRef)))
      (setq vec (cadr (refgeom blkRef)))

      ;; Copy transformed version to modelspace
      (copy-entity-from-block blkName foundEnt mat vec)

      ;; From LeeMac
      ;; https://www.cadtutor.net/forum/topic/38670-delete-entity-in-nested-block/#findComment-315220
      ;; Remove the entity from the block definition

      (vla-delete (vlax-ename->vla-object foundEnt))

      ;; Regen
      (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acactiveviewport)
      (princ 
        (strcat "\nObject removed from block: " blkName ", all instances updated.")
      )
    )
    (princ "\nInvalid block reference selected.")
  )
  (princ)
)

(princ "\nType ROB to remove an object from a block and update all its instances.")
(princ)

Select Multiple objects in the block...

;;; Remove multiple objects from block and keep it, update all the block instances.
;;;
;;; https://www.cadtutor.net/forum/topic/97778-hello-every-one-please-review-and-help/#findComment-671730 
;;;
;;; By SLW210 (a.k.a. Steve Wilson)
;;;
;;;_____________________________________________________________________________________________________________________________
;;;                                                                                                                             |
;;; Might be messy, I started with something I had for copying an object from a block, still in progress (CopObj.lsp).          |
;;;                                                                                                                             |
;;; Added the delete from LeeMac. https://www.cadtutor.net/forum/topic/38670-delete-entity-in-nested-block/#findComment-315220  |
;;;                                                                                                                             |
;;; Updated with information from Lee Mac's response to a thread... See below                                                   |
;;;                                                                                                                             |
;;; All of the heavy lifting done by Lee Mac, Gile, Doug Wilson and Vladimir Nesterovsky, hopefully I didn't make it too messy. |
;;;                                                                                                                             |
;;;_____________________________________________________________________________________________________________________________|
;;;
;;;###############################################################################################################################
;;; From LeeMac
;;; https://www.cadtutor.net/forum/topic/63984-getting-a-point-of-an-entity-inside-a-block-as-wcs-coordinates/#findComment-527265
;;; Getting a point of an entity inside a block as WCS coordinates
;;;
;;;###############################################################################################################################

;;; Matrix Transpose  -  Doug Wilson
;;; Args: m - nxn matrix

(defun trp (m) (apply 'mapcar (cons 'list m)))

;;; Matrix x Matrix  -  Vladimir Nesterovsky
;;; Args: m,n - nxn matrices

(defun mxm (m n) ((lambda (a) (mapcar '(lambda (r) (mxv a r)) m)) (trp n)))

;;; Matrix x Vector  -  Vladimir Nesterovsky
;;; Args: m - nxn matrix, v - vector in R^n

(defun mxv (m v) (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m))

;;; RefGeom (gile)
;;; Returns a list whose first item is a 3x3 transformation matrix and
;;; second item the object insertion point in its parent (xref, block or space)
(defun refgeom (ent / ang enx mat ocs) 
  (setq enx (entget ent)
        ang (cdr (assoc 50 enx))
        ocs (cdr (assoc 210 enx))
  )
  (list 
    (setq mat (mxm 
                (mapcar '(lambda (v) (trans v 0 ocs t)) 
                        '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
                )
                (mxm 
                  (list 
                    (list (cos ang) (- (sin ang)) 0.0)
                    (list (sin ang) (cos ang) 0.0)
                    '(0.0 0.0 1.0)
                  )
                  (list 
                    (list (cdr (assoc 41 enx)) 0.0 0.0)
                    (list 0.0 (cdr (assoc 42 enx)) 0.0)
                    (list 0.0 0.0 (cdr (assoc 43 enx)))
                  )
                )
              )
    )
    (mapcar 
      '-
      (trans (cdr (assoc 10 enx)) ocs 0)
      (mxv mat (cdr (assoc 10 (tblsearch "block" (cdr (assoc 2 enx))))))
    )
  )
)

(defun transform-entity-by-ref (edata mat vec) 
  (mapcar 
    (function 
      (lambda (pair) 
        (if (and (numberp (car pair)) (member (car pair) '(10 11 12 13))) 
          (cons (car pair) (mapcar '+ (mxv mat (cdr pair)) vec))
          pair
        )
      )
    )
    edata
  )
)

(defun copy-entity-from-block (realEnt mat vec) 
  (cond 
    ((wcmatch (cdr (assoc 0 (entget realEnt))) "POLYLINE")
     (while (and realEnt (/= (cdr (assoc 0 (entget realEnt))) "SEQEND")) 
       (setq edata (entget realEnt))
       (setq edata (transform-entity-by-ref edata mat vec))
       (entmake edata)
       (setq realEnt (entnext realEnt))
     )
     (entmake (entget realEnt))
    )
    (T
     (setq edata (entget realEnt))
     (setq edata (transform-entity-by-ref edata mat vec))
     (entmake edata)
    )
  )
)
;;;#############################################################################################################################################

(defun c:ROBM (/ blkRef blkName blkDef blkRefEnt mat vec blkDefEnt foundEnt selEnt 
               pickHandle done pickEnt
              ) 
  (vl-load-com)
  (princ "\nSelect block reference that contains the object.")
  (setq blkRef (car (entsel "\nSelect block reference: ")))

  (if (and blkRef (= (cdr (assoc 0 (entget blkRef))) "INSERT")) 
    (progn 
      (setq blkRefEnt (entget blkRef))
      (setq blkName (cdr (assoc 2 blkRefEnt)))
      (setq blkDef (tblobjname "BLOCK" blkName))
      (setq mat (car (refgeom blkRef)))
      (setq vec (cadr (refgeom blkRef)))
      (princ (strcat "\nYou selected block: " blkName))
      (princ "\nNow select objects inside the block (press Enter when done).")

      (setq done nil)
      (while (not done) 
        (setq selEnt (nentsel "\nSelect object inside the block <Enter to finish>: "))
        (if selEnt 
          (progn 
            (setq pickEnt (car selEnt))
            (setq pickHandle (cdr (assoc 5 (entget pickEnt))))

            ;; Search block definition
            (setq blkDefEnt (entnext blkDef))
            (setq foundEnt nil)
            (while (and blkDefEnt (not foundEnt)) 
              (if (= (cdr (assoc 5 (entget blkDefEnt))) pickHandle) 
                (setq foundEnt blkDefEnt)
                (setq blkDefEnt (entnext blkDefEnt))
              )
            )

            (if foundEnt 
              (progn 
                (copy-entity-from-block foundEnt mat vec)

                ;; From LeeMac
                ;; https://www.cadtutor.net/forum/topic/38670-delete-entity-in-nested-block/#findComment-315220
                ;; Remove the entity from the block definition

                (vla-delete (vlax-ename->vla-object foundEnt))
                (princ (strcat "\nEntity with handle " pickHandle " removed."))
              )
              (princ 
                (strcat "\nHandle " pickHandle " not found in block definition.")
              )
            )
          )
          (setq done T)
        )
      )

      ;; Regen
      (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acactiveviewport)
      (princ 
        (strcat "\nFinished. Selected objects removed from block " 
                blkName
                " and copied to model space."
        )
      )
    )
    (princ "\nInvalid block reference selected.")
  )
  (princ)
)

(princ "\nType ROBM to remove one or more objects from a block and copy to model space.")
(princ)

Sign In

hello every one . Please review and help

Recommended Posts

CAD2005

nod684

CAD2005

SLW210

SLW210

CAD2005

SLW210

CAD2005

SLW210

GLAVCVS

SLW210

GLAVCVS

SLW210

Join the conversation

Tutorials

Forums

Activity