Jump to content

Replace blocks with other master block - need help with LM:getattributevalue

aridzv

By aridzv
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

aridzv Rising Star

aridzv

Posted
Posted (edited)

Hi.

I'm looking for a lisp that will do this:

1. replace blocks with a master block - selecting one block or many and replace them with master block.

2. replace the attributes values of the old replaced blocks with the attributes value of the master block.

    both the old replaced blocks and the master block have the same attributes tags,and thier names can be hard-coded If it makes it easier.

3. let the replaced blocks keep their position in 3D.

I found a lisp called ReplaceBlockS.lsp and I'm trying to revise it by adding LM:getattributevalue to the lisp this way and its fails: 

(defun c:ReplaceBlockS1 () (c:RBS))
(defun c:RBS (/ answr ent idx new_block newname obj ss att objn M1 M2 M3 C1 C2 C3 E1 E2 E3 ITD GR ORD QTY SYS UN)
 (vl-load-com)
 (command ".undo" "be")
 ;;if the user selects something, inputs a ne block name AND it exists in the dwg...
 (if (and (setq ss (ssget ":S" '((0 . "INSERT"))))
   (setq new_block (entget (car (entsel "\nPick instance of new block: "))))
   ;;(setq objn (vlax-ename->vla-object (entlast)))
   (setq newname (cdr (assoc 2 new_block)))
   (tblobjname "BLOCK" newname)
 
    ;;(if  (= (vla-get-hasattributes objn) :vlax-true)
    ;;  (foreach att (vlax-invoke objn 'getattributes))
    ;;)

     (setq M1 (LM:getattributevalue new_block "MAN1"))
;;   (setq M2 (strcase (vla-get-tagstring "MAN2")))
;;   (setq M3 (strcase (vla-get-tagstring "MAN3")))
;;   (setq C1 (strcase (vla-get-tagstring "CAT1")))
;;   (setq C2 (strcase (vla-get-tagstring "CAT2")))
;;   (setq C3 (strcase (vla-get-tagstring "CAT3")))
;;   (setq E1 (strcase (vla-get-tagstring "ERP1")))
;;   (setq E2 (strcase (vla-get-tagstring "ERP2")))
;;   (setq E3 (strcase (vla-get-tagstring "ERP3")))
;;   (setq ITD (strcase (vla-get-tagstring "ITEM_DESCRIPTION")))
;;   (setq GR (strcase (vla-get-tagstring "GRUOP")))
;;   (setq ORD (strcase (vla-get-tagstring "ORDER")))
;;   (setq QTY (strcase (vla-get-tagstring "QUANTITY")))
;;   (setq SYS (strcase (vla-get-tagstring "SYSTEM")))
;;   (setq UN (strcase (vla-get-tagstring "UNIT")))

   )
   (progn
     (setq idx -1)
     (while (setq ent (ssname ss (setq idx (1+ idx))))
(setq obj (vlax-ename->vla-object ent))

(vla-put-name obj newname);;change the name

(vlax-invoke obj 'getattributes)

(vla-put-textstring "MAN1" M1)
;;(vla-put-textstring "MAN2" M2)
;;(vla-put-textstring "MAN3" M3)
;;(vla-put-textstring "CAT1" C1)
;;(vla-put-textstring "CAT2" C2)
;;(vla-put-textstring "CAT3" C3)
;;(vla-put-textstring "ERP1" E1)
;;(vla-put-textstring "ERP2" E2)
;;(vla-put-textstring "ERP3" E3)
;;(vla-put-textstring "ITEM_DESCRIPTION" ITD)
;;(vla-put-textstring "GRUOP" GR)
;;(vla-put-textstring "ORDER" ORD)
;;(vla-put-textstring "QUANTITY" QTY)
;;(vla-put-textstring "SYSTEM" SYS)
;;(vla-put-textstring "UNIT" UN)

(vla-update obj)
)
     )
   )
 (command ".undo" "end")
 (princ (strcat "\nReplaced " (itoa idx) " blocks......"))
 (princ)
 )

;; Get Attribute Value  -  Lee Mac
;; Returns the value held by the specified tag within the supplied block, if present.
;; blk - [ent] Block (Insert) Entity Name
;; tag - [str] Attribute TagString
;; Returns: [str] Attribute value, else nil if tag is not found.

(defun LM:getattributevalue ( blk tag / val enx )
    (while
        (and
            (null val)
            (setq blk (entnext blk))
            (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk)))))
        )
        (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
            (setq val (cdr (assoc 1 (reverse enx))))
        )
    )
)

 

thanks,

aridzv.

 

Edited by aridzv
  • aridzv changed the title to Replace blocks with other master block - need help with LM:getattributevalue
BIGAL Grand Master

BIGAL

Posted
Posted

Have you tried bringing in a new block of same name from a separate dwg ? It should ask do you want to "Redefine" the block and will update the attributes.

 

aridzv Rising Star

aridzv

Posted
  • Author
Posted (edited)

Hi @BIGAL

I manage to get it working - see the code below. 

(defun c:ReplaceBlockS1 () (c:RBS))
(defun c:RBS (/ answr ent idx new_block newname obj ss att objn M1 M2 M3 C1 C2 C3 E1 E2 E3 ITD GR ORD QTY SYS UN blk1)
 (vl-load-com)
 (command ".undo" "be")
 ;;if the user selects something, inputs a ne block name AND it exists in the dwg...
 (if (and (setq ss (ssget ":S" '((0 . "INSERT"))))
   (setq new_block (entget (car (entsel "\nPick instance of new block: "))))
   (setq blk1 (entsel "\nPick instance of new block again: ")) 
   (setq objn (vlax-ename->vla-object (entlast)))
   (setq newname (cdr (assoc 2 new_block)))
   (tblobjname "BLOCK" newname)


  

    ;;(if  (= (vla-get-hasattributes objn) :vlax-true)
    ;;  (foreach att (vlax-invoke objn 'getattributes))
    ;;)

     (setq M1 (LM:getattributevalue (car blk1) "MAN1"))
(princ M1)
;;   (setq M2 (strcase (vla-get-tagstring "MAN2")))
;;   (setq M3 (strcase (vla-get-tagstring "MAN3")))
;;   (setq C1 (strcase (vla-get-tagstring "CAT1")))
;;   (setq C2 (strcase (vla-get-tagstring "CAT2")))
;;   (setq C3 (strcase (vla-get-tagstring "CAT3")))
;;   (setq E1 (strcase (vla-get-tagstring "ERP1")))
;;   (setq E2 (strcase (vla-get-tagstring "ERP2")))
;;   (setq E3 (strcase (vla-get-tagstring "ERP3")))
;;   (setq ITD (strcase (vla-get-tagstring "ITEM_DESCRIPTION")))
;;   (setq GR (strcase (vla-get-tagstring "GRUOP")))
;;   (setq ORD (strcase (vla-get-tagstring "ORDER")))
;;   (setq QTY (strcase (vla-get-tagstring "QUANTITY")))
;;   (setq SYS (strcase (vla-get-tagstring "SYSTEM")))
;;   (setq UN (strcase (vla-get-tagstring "UNIT")))

   )
   (progn
     (setq idx -1)
     (while (setq ent (ssname ss (setq idx (1+ idx))))
(setq obj (vlax-ename->vla-object ent))

(vla-put-name obj newname);;change the name



;;(vlax-invoke obj 'getattributes)

(LM:setattributevalue ent "MAN1" M1)

;;(vla-put-textstring "MAN1" M1)
;;(vla-put-textstring "MAN2" M2)
;;(vla-put-textstring "MAN3" M3)
;;(vla-put-textstring "CAT1" C1)
;;(vla-put-textstring "CAT2" C2)
;;(vla-put-textstring "CAT3" C3)
;;(vla-put-textstring "ERP1" E1)
;;(vla-put-textstring "ERP2" E2)
;;(vla-put-textstring "ERP3" E3)
;;(vla-put-textstring "ITEM_DESCRIPTION" ITD)
;;(vla-put-textstring "GRUOP" GR)
;;(vla-put-textstring "ORDER" ORD)
;;(vla-put-textstring "QUANTITY" QTY)
;;(vla-put-textstring "SYSTEM" SYS)
;;(vla-put-textstring "UNIT" UN)

(vla-update obj)
)
     )
   )
 (command ".undo" "end")
 (princ (strcat "\nReplaced " (itoa idx) " blocks......"))
 (princ)
 )

;; Get Attribute Value  -  Lee Mac
;; Returns the value held by the specified tag within the supplied block, if present.
;; blk - [ent] Block (Insert) Entity Name
;; tag - [str] Attribute TagString
;; Returns: [str] Attribute value, else nil if tag is not found.

(defun LM:getattributevalue ( blk tag / val enx )
    (while
        (and
            (null val)
            (setq blk (entnext blk))
            (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk)))))
        )
        (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
            (setq val (cdr (assoc 1 (reverse enx))))
        )
    )
)


;; Set Attribute Value  -  Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [ent] Block (Insert) Entity Name
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.

(defun LM:setattributevalue ( blk tag val / enx )
    (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
        (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
            (if (entmod (subst (cons 1 val) (assoc 1 (reverse enx)) enx))
                (progn
                    (entupd blk)
                    val
                )
            )
            (LM:setattributevalue blk tag val)
        )
    )
)

 

18 hours ago, BIGAL said:

Have you tried bringing in a new block of same name from a separate dwg ? It should ask do you want to "Redefine" the block and will update the attributes.

 

 

the issue is replacing one block with other.

for exmple replace a block of bolt M20x80mm with a block of bolt 3/4"x80mm.

and yes,I tried - insert and redefine don't update the attributes value.

Edited by aridzv
aridzv Rising Star

aridzv

Posted
  • Author
Posted (edited)

Here is the final lisp that works,

see the differance between autocad and bricscad: 

(defun c:ReplaceBlockS () (c:RBS))
(defun c:RBS (/ answr ent idx newblock newname blk newblock obj ss M1 M2 M3 C1 C2 C3 E1 E2 E3 ITD GR ORD QTY QTY1 SYS UN MANDIA MANGR x)
 (vl-load-com)

(setq temperr *error*);;store *error*
(setq *error* trap1);;re-assign *error*

(setvar "CMDECHO" 0)
 (command ".undo" "be")
(setvar "CMDECHO" 1)

(princ)
(prompt "\nselect blocks,Enter To End Selection")
 ;;if the user selects something, inputs a ne block name AND it exists in the dwg...
 (if (and (setq ss (ssget '((0 . "INSERT")))) ;; (ssget ":S" '((0 . "INSERT")))
   ;;(setq newblock (entget (car (entsel "\nPick instance of new block: ")))) ;;Autocad
   (setq newblock (entsel "\nPick instance of new block: ")) ;;Bricscad
   (setq newname (getpropertyvalue (car newblock) "EffectiveName~Native")) ;;Bricscad
   ;;(setq newname (cdr (assoc 2 newblock))) ;;Autocad
   (tblobjname "BLOCK" newname)

(vl-catch-all-apply (setq M1 (LM:getattributevalue (car newblock) "MAN1")))
(vl-catch-all-apply (setq M2 (LM:getattributevalue (car newblock) "MAN2")))
(vl-catch-all-apply (setq M3 (LM:getattributevalue (car newblock) "MAN3")))
(vl-catch-all-apply (setq C1 (LM:getattributevalue (car newblock) "CAT1")))
(vl-catch-all-apply (setq C2 (LM:getattributevalue (car newblock) "CAT2")))
(vl-catch-all-apply (setq C3 (LM:getattributevalue (car newblock) "CAT3")))
(vl-catch-all-apply (setq E1 (LM:getattributevalue (car newblock) "ERP1")))
(vl-catch-all-apply (setq E2 (LM:getattributevalue (car newblock) "ERP2")))
(vl-catch-all-apply (setq E3 (LM:getattributevalue (car newblock) "ERP3")))
(vl-catch-all-apply (setq ITD (LM:getattributevalue (car newblock) "ITEM_DESCRIPTION")))
(vl-catch-all-apply (setq GR (LM:getattributevalue (car newblock) "GRUOP")))
(vl-catch-all-apply (setq UN (LM:getattributevalue (car newblock) "UNIT")))
(vl-catch-all-apply (setq MANDIA (LM:getattributevalue (car newblock) "MANIFOLD_DIA")))
(vl-catch-all-apply (setq MANGR (LM:getattributevalue (car newblock) "MANIFOLD_GRUOP")))
;;(vl-catch-all-apply (setq ORD (LM:getattributevalue (car newblock) "ORDER"))) ;; don't change
;;(vl-catch-all-apply (setq SYS (LM:getattributevalue (car newblock) "SYSTEM"))) ;; don't change
(vl-catch-all-apply (setq QTY (LM:getattributevalue (car newblock) "QUANTITY"))) ;; don't change


;;   (setq M2 (strcase (vla-get-tagstring "MAN2")))
;;   (setq M3 (strcase (vla-get-tagstring "MAN3")))
;;   (setq C1 (strcase (vla-get-tagstring "CAT1")))
;;   (setq C2 (strcase (vla-get-tagstring "CAT2")))
;;   (setq C3 (strcase (vla-get-tagstring "CAT3")))
;;   (setq E1 (strcase (vla-get-tagstring "ERP1")))
;;   (setq E2 (strcase (vla-get-tagstring "ERP2")))
;;   (setq E3 (strcase (vla-get-tagstring "ERP3")))
;;   (setq ITD (strcase (vla-get-tagstring "ITEM_DESCRIPTION")))
;;   (setq GR (strcase (vla-get-tagstring "GRUOP")))
;;   (setq ORD (strcase (vla-get-tagstring "ORDER")))
;;   (setq QTY (strcase (vla-get-tagstring "QUANTITY")))
;;   (setq SYS (strcase (vla-get-tagstring "SYSTEM")))
;;   (setq UN (strcase (vla-get-tagstring "UNIT")))
;;   (setq MANDIA (strcase (vla-get-tagstring "MANIFOLD_DIA")))
;;   (setq NANGR (strcase (vla-get-tagstring "MANIFOLD_GRUOP")))


   )
   (progn
     (setq idx -1)
     (while (setq ent (ssname ss (setq idx (1+ idx))))
(setq obj (vlax-ename->vla-object ent))
(vla-put-name obj newname);;change the name



 (if (setq x (getpropertyvalue ent "d1"))
  (progn
        (vl-catch-all-apply (setq QTY1 (LM:getattributevalue ent "QUANTITY")))
	(vl-catch-all-apply (setq QTY1 (* 1000 (atof QTY1))))
	(vl-catch-all-apply (setq QTY1 (rtos QTY1 2 3)))
	(vl-catch-all-apply (setpropertyvalue ent "d1" QTY1))
   )    
)

(vl-catch-all-apply (LM:setattributevalue ent "MAN1" M1))
(vl-catch-all-apply (LM:setattributevalue ent "MAN2" M2))
(vl-catch-all-apply (LM:setattributevalue ent "MAN3" M3))
(vl-catch-all-apply (LM:setattributevalue ent "CAT1" C1))
(vl-catch-all-apply (LM:setattributevalue ent "CAT2" C2))
(vl-catch-all-apply (LM:setattributevalue ent "CAT3" C3))
(vl-catch-all-apply (LM:setattributevalue ent "ERP1" E1))
(vl-catch-all-apply (LM:setattributevalue ent "ERP2" E2))
(vl-catch-all-apply (LM:setattributevalue ent "ERP3" E3))
(vl-catch-all-apply (LM:setattributevalue ent "ITEM_DESCRIPTION" ITD))
(vl-catch-all-apply (LM:setattributevalue ent "GRUOP" GR))
(vl-catch-all-apply (LM:setattributevalue ent "UNIT" UN))
(vl-catch-all-apply (LM:setattributevalue ent "MANIFOLD_DIA" MANDIA))
(vl-catch-all-apply (LM:setattributevalue ent "MANIFOLD_GRUOP" MANGR))
;;(vl-catch-all-apply (LM:setattributevalue ent "ORDER" ORD)) ;; DON'T CHANGE
;;(vl-catch-all-apply (LM:setattributevalue ent "QUANTITY" QTY)) ;; DON'T CHANGE
;;(vl-catch-all-apply (LM:setattributevalue ent "SYSTEM" SYS)) ;; DON'T CHANGE

;;(vla-put-textstring "MAN1" M1)
;;(vla-put-textstring "MAN2" M2)
;;(vla-put-textstring "MAN3" M3)
;;(vla-put-textstring "CAT1" C1)
;;(vla-put-textstring "CAT2" C2)
;;(vla-put-textstring "CAT3" C3)
;;(vla-put-textstring "ERP1" E1)
;;(vla-put-textstring "ERP2" E2)
;;(vla-put-textstring "ERP3" E3)
;;(vla-put-textstring "ITEM_DESCRIPTION" ITD)
;;(vla-put-textstring "GRUOP" GR)
;;(vla-put-textstring "ORDER" ORD)
;;(vla-put-textstring "QUANTITY" QTY)
;;(vla-put-textstring "SYSTEM" SYS)
;;(vla-put-textstring "UNIT" UN)

(vla-update obj)
)
     )
   )
 (command ".undo" "end")
 (princ (strcat "\nReplaced " (itoa idx) " blocks......"))
 (princ)
 )

;; Get Attribute Value  -  Lee Mac
;; Returns the value held by the specified tag within the supplied block, if present.
;; blk - [ent] Block (Insert) Entity Name
;; tag - [str] Attribute TagString
;; Returns: [str] Attribute value, else nil if tag is not found.

(defun LM:getattributevalue ( blk tag / val enx )
    (while
        (and
            (null val)
            (setq blk (entnext blk))
            (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk)))))
        )
        (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
            (setq val (cdr (assoc 1 (reverse enx))))
        )
    )
)


;; Set Attribute Value  -  Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [ent] Block (Insert) Entity Name
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.

(defun LM:setattributevalue ( blk tag val / enx )
    (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
        (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
            (if (entmod (subst (cons 1 val) (assoc 1 (reverse enx)) enx))
                (progn
                    (entupd blk)
                    val
                )
            )
            (LM:setattributevalue blk tag val)
        )
    )
)

 

Edited by aridzv

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...