Lisp Combine and Update

[cabltv1]

Please help!

I need a lisp routine that does the following...

1) Select a block.

2) Get the information from 2 seperate TAGs in the block

First TAG: NODE_ID

Second TAG: DEVICE-TYPE_ID

3) I then need the two TAGs above to be combined with a dash (-) in between. Example:

First TAG: NODE_ID = 1256

Second TAG: DEVICE-TYPE_ID = C5B3

Final = 1256-C5B3

4) I then need a "pause" to select several different blocks and update the following TAG...

TAG: ACTIVE with the combined results..

TAG: ACTIVE = 1256-C5B3

 

Any help would be greatly appreciated.

[fixo]

Try this one

;; cca.lsp

(defun C:CCA  (/ attent atttag attval elist en head pt ss tail)
 (setq osm (getvar "osmode"))
 (setvar "osmode" 513)
 (setq	pt (getpoint
     "\n   ***   Specify point on the source block   ***"))

 (setq ss (ssget pt (list (cons 0 "INSERT") (cons 66 1))))
 (sssetfirst nil ss)
 (if ss
   (progn
     (setq en (ssname ss 0))
     (setq elist (entget en))
     (while (=	(cdr
	  (assoc 0
		 (setq elist (entget (entnext
				       (setq attent (cdr (assoc -1 elist))))))))
	"ATTRIB")
(setq atttag (cdr (assoc 2 elist)))
(setq attval (cdr (assoc 1 elist)))
(cond ((eq "NODE_ID" atttag)
       (setq head (cdr (assoc 1 elist))))
      ((eq "DEVICE-TYPE_ID" atttag)
       (setq tail (cdr (assoc 1 elist))))
      (T nil)
      )
(ssdel en ss)
)
     )
   (princ "\n   0 blocks selected")
   )
 (sssetfirst nil nil)
 (setq ss nil)
 (prompt
   "\n   ***   Select all target blocks you need to update   ***")
 (setq ss (ssget (list (cons 0 "INSERT") (cons 66 1))))
 (sssetfirst nil ss)
 (if (and head tail ss)
   (progn
     (while
(setq en (ssname ss 0))
 (setq elist (entget en))
 (while	(= (cdr
	     (assoc 0
		    (setq elist	(entget	(entnext
					  (setq attent (cdr (assoc -1 elist))))))))
	   "ATTRIB")
   (setq atttag (cdr (assoc 2 elist)))

   (if (eq "ACTIVE" atttag)
     (progn
       (entmod (subst (cons 1 (strcat head "-" tail))
		      (assoc 1 elist)
		      elist))
       (entupd en)
       )
     )
   (ssdel en ss)
   )
 )
     (sssetfirst nil nil)
     )
   (princ "\n   0 blocks selected")
   )
 (setvar "osmode" osm)
 (princ)
 )
(princ "   ***   Start command wit CCA   ***")
(princ)

 

~'J'~

[cabltv1]

Fixo,

Thanks for your quick reply. I tried the routine and the first half works but the second part doesn't.

I select the source block then select blocks that need the update and the following happens....

First TAG: NODE_ID (This does update the destination block/TAG:Active [including the dash]).

The second source block TAG: DEVICE-TYPE_ID (is missing in destination block/TAG:Active [including the dash]).

Example:

Source Block: First TAG: NODE_ID = 1256

Second TAG: DEVICE-TYPE_ID = C5B3

==============================

After update...

Destination block: TAG: ACTIVE = "1256-"

The "C5B3" is missing at the end in destination block.

[Lee Mac]

Try this:

 

(defun c:tagupd (/ bEnt aEnt aEntLst aNode aType nAtt ss entLst dAtt dAttLst)
 (vl-load-com)
 (if (and (setq bEnt (car (entsel "\nSelect Block to Retrieve Tag Values >  ")))
      (= "INSERT" (cdr (assoc 0 (entget bEnt))))
      (= 1 (cdr (assoc 66 (entget bEnt)))))
   (progn
     (setq aEnt (entnext bEnt))
     (while (not (eq "SEQEND" (cdr (assoc 0 (setq aEntLst (entget aEnt))))))
   (cond ((= "NODE_ID" (cdr (assoc 2 aEntLst)))
          (setq aNode (cdr (assoc 1 aEntLst))))
         ((= "DEVICE-TYPE_ID" (cdr (assoc 2 aEntLst)))
          (setq aType (cdr (assoc 1 aEntLst)))))
   (setq aEnt (entnext aEnt)))
     (setq nAtt (strcat aNode (chr 45) aType))
     (if (setq ss (ssget (list (cons 0 "INSERT") (cons 66 1)
   (if (getvar "CTAB") (cons 410 (getvar "CTAB")) (cons 67 (- 1 (getvar "TILEMODE")))))))
   (progn
     (setq entLst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
     (foreach ent entLst
       (setq dAtt (entnext ent))
       (while (not (eq "SEQEND" (cdr (assoc 0 (setq dAttLst (entget dAtt))))))
         (if (= "ACTIVE" (cdr (assoc 2 dAttLst)))
       (setq dAttLst (subst (cons 1 nAtt) (assoc 1 dAttLst) dAttLst))
       (entmod dAttLst))
         (setq dAtt (entnext dAtt)))))
   (princ "\n<!> No Destination Blocks Selected <!>")))
   (princ "\n<!> No Attributed Block Selected <!>"))
 (command "_regenall")
 (princ))

[Lee Mac]

Sorry, 1 thing missed:

 

(defun c:tagupd (/ bEnt aEnt aEntLst aNode aType nAtt ss entLst dAtt dAttLst)
 (vl-load-com)
 (if (and (setq bEnt (car (entsel "\nSelect Block to Retrieve Tag Values >  ")))
      (= "INSERT" (cdr (assoc 0 (entget bEnt))))
      (= 1 (cdr (assoc 66 (entget bEnt)))))
   (progn
     (setq aEnt (entnext bEnt))
     (while (not (eq "SEQEND" (cdr (assoc 0 (setq aEntLst (entget aEnt))))))
   (cond ((= "NODE_ID" (cdr (assoc 2 aEntLst)))
          (setq aNode (cdr (assoc 1 aEntLst))))
         ((= "DEVICE-TYPE_ID" (cdr (assoc 2 aEntLst)))
          (setq aType (cdr (assoc 1 aEntLst)))))
   (setq aEnt (entnext aEnt)))
     (setq nAtt (strcat aNode (chr 45) aType))
     (if (setq ss (ssget (list (cons 0 "INSERT") (cons 66 1)
   (if (getvar "CTAB") (cons 410 (getvar "CTAB")) (cons 67 (- 1 (getvar "TILEMODE")))))))
   (progn
     (setq entLst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
     (foreach ent entLst
       (setq dAtt (entnext ent))
       (while (not (eq "SEQEND" (cdr (assoc 0 (setq dAttLst (entget dAtt))))))
         (if (= "ACTIVE" (cdr (assoc 2 dAttLst)))
       (progn
       (setq dAttLst (subst (cons 1 nAtt) (assoc 1 dAttLst) dAttLst))
       (entmod dAttLst)))
         (setq dAtt (entnext dAtt)))))
   (princ "\n<!> No Destination Blocks Selected <!>")))
   (princ "\n<!> No Attributed Block Selected <!>"))
 (command "_regenall")
 (princ))

[cabltv1]

Lee,

Works perfectly!

Thank you very much. You saved me a lot of time trying to figure this out on my own.

[Lee Mac]

Lee,

Works perfectly!

Thank you very much. You saved me a lot of time trying to figure this out on my own.

 

 

No probs cabltv, - your LISP requests all seem much of a muchness, but good practice all the same

[blue-drafter]

I have a similar need to the above post. I need to transfer the balance of an attribute string to another block. I have attached an AutoCAD file with the table of information to transfer to the part tag block.

ATT-TRANSFER.dwg

[BIGAL]

Not really sure what you want but you can do just about anything with multiple blocks its just a case of identifying them, in your case are you saying a block with a lable MM01 is to be updated but exists 55 times ?

 

Just as a reference we have a pit schedule updator that can take info from all over the place but updates the single schedule no matter where it is in the drawing again just a case of block names & tags.

 

Do a bit more research on updating attributes automatically.

[blue-drafter]

Bigal, I attached a new CAD file with directions of what I need. thanks

BOM.dwg