LISP To Wedge In Additional Attribute To Block Reference

stev98312 · ‎07-19-2024

I have been tasked with updating and bringing to current standards, hundreds of drawings; each with hundreds of block references (attributed text).
The block references are text objects (not MTEXT) and each block reference has, or should have, 7 attributes.
I have recently discovered block references with the 4th attribute missing. These were made long ago with a modified routine. After fiddling for a bit, I set up an example for the attached DWG.
I have lisp programs that will append a Tag, Prompt and Value to the end of the list in a block reference, but have found none that can wedge these into the middle of an existing list, where this needs to be for follow-on processing, and where the order of things is important.
Complicating things is the fact that each block reference must have a different block number for export to a database. All block references are supposed to have the same 7 attributes each with a set of values unique to that particular block reference. I can't just fix one and sync others to it (?).
After a week of remaking these block reference to replace the missing attribute, because that's the only way I see it now, I have come here seeking assistance/advice. My searches for a suitable fix are coming up empty, and remaking all these is starting to draw a mean vacuum.

Ideally, the program would start checking block references and if the certain tag does not exist, insert the Tag, Prompt and Value into the correct position and then go find the next occurance.
Is this even possible?
The missing Tag is MRIN, The missing Prompt is "Enter MRIN" and the Value is blank by default; filled in later in processing.

Attached is a DWG with examples. It's saved in 2010 format so should open for most folks.
And just in case it's of help, below is an exerpt from the ancient program that makes these block references. The program was written over 30 years ago and, amazingly, still works in Autocad 2022.

;; dscord is the insertion point, established earlier in the program

(progn 
  (command "attdef" "" "NAME" "Enter NAME." textdat dscord "")
  (setq nameattr1 (entlast))
  (command "attdef" "" "RIN" "Enter OBJ ID." RIN dscord "")
  (setq nameattr2 (entlast))
  (command "attdef" "" "BOXSIZE" "Box Coordinates.     " bsize dscord "")
  (setq nameattr3 (entlast))
;
  (command "attdef" "" "MRIN" "Enter MRIN." mrin dscord "") ; <--- The missing one
  (setq nameattr4 (entlast))
;
  (command "attdef" "" "CURRENTLAYER" "Enter CurrentLayer." "NOPLOT" dscord "")
  (setq nameattr5 (entlast))
  (command "attdef" "" "SHAPE" "Enter Object ShapeType." "R" dscord "")
  (setq nameattr6 (entlast))
  (command "attdef" "" "OBJTYPE" "Enter ObjectType." "EQ" dscord "")
  (setq nameattr7 (entlast))
  (setq bname (itoa atblk))
  (while (tblsearch "BLOCK" (strcat drawname "$ECC$" bname))
    (progn
      (setq atblk (+ atblk 1)
            bname (itoa atblk)
      )
    )
  )
  (setq bname (strcat drawname "$ECC$" bname))
  (progn 
    (command "block" bname dscord nameattr1 nameattr2 nameattr3 nameattr4 nameattr5 nameattr6 nameattr7)
    (setq count 0
          emax  (sslength ss2)
    )
    (while (< count emax)
      (command (ssname ss2 count))
      (setq count (1+ count))
    )
    (command "" "insert" bname dscord "1" "1" "0")
  )
)

Thanks for any help,
Steve

Sea-Haven · ‎07-19-2024

Try googling "change attribute order autocad lisp" found 1 by Pbe that may do what you want.

Solved: LISP for Re-ordering block Attributes - Autodesk Community - AutoCAD

pbejse · ‎07-20-2024

@stev98312 wrote:

The missing Tag is MRIN, The missing Prompt is "Enter MRIN" and the Value is blank by default; filled in later in processing.

Quick question, is redefining a block thru Design Center and calling attsync not an option? it's just one option to consider.

After adding the missing attribute in the correct just leave it blank?

Are you planning to use the value from this block using another lisp program? if yes maybe you did even need to re-order the attributes?

IF the answers to both question is no, then we write a program. How's that sound?

@Sea-Haven

Thank you for that link, i was looking for that weeks ago.

Sea-Haven · ‎07-20-2024

@pbejse I lose stuff all the time starting to save in a more accessible way. I use Windows CMD FINDSTR to look for key word. It searches a directory very fast. pretty sure can do /s subdirectory also.

FINDSTR wblock *.lsp

Often thought must save key words in say excel so can sort columns etc.

stev98312 · ‎07-20-2024

@Sea-Haven
Thanks for the link. I had seen that program by pbejse in my searches and when I tried the program, it reversed the order of the attributes. But because I have a mental block with VL/VLA/VLAX stuff, I couldn't figure how to get things in the order I need.

Steve

stev98312 · ‎07-20-2024

@pbejse
Redefining in Design Center appears not to be an option, as I cannot figure how to use it to re-order attributes or to add one. And if I understand correctly, each block referrence is a distinct entity with its own unique block number, there is nothing to sync it to (?).

Yes. After adding the missing attribute line, Value can be left blank.

For processing, the Autocad drawing is dissected by some custom software that extracts block reference data to a SQL database for use by yet another program.

Currently, as I find each block reference without the MRIN tag, prompt and value, I add it (to the bottom of the list) with a modified version of a program written by @john.uhden, and then re-order attributes with BATTMAN. But by golly, it's tedious and slow going.
That's why I was seeking a program that could insert to a specific place rather than just add to the end. Inserting to the end requires still more manipulation with BATTMAN to move it to 4th position. Inserting directly to 4th position between BOXSIZE and CURRENTLAYER is the dream.

Steve

Sea-Haven · ‎07-20-2024

I am sure Pbe will respond. May be just a (reverse list) required.

pbejse · ‎07-21-2024

@stev98312 wrote:

Redefining in Design Center appears not to be an option, as I cannot figure how to use it to re-order attributes or to add one

IF you have one FIXED attribute block, you dont need to reorder each and every time. Redefine using @

pbejse · ‎07-21-2024

@stev98312 wrote:

That's why I was seeking a program that could insert to a specific place rather than just add to the end.

If we have time we will do the "Insert", for the meantime, we will rehash the code on the link posted by @sea-posted earlier.

(Defun c:Wedgie ( / tagNames addMRIN attdefProp blockCollection a blockName attrFromBlock attData blockNameCollection)
(setvar 'cmdecho 0)
(setq tagNames	 '("NAME" "RIN"	"BOXSIZE" "MRIN" "CURRENTLAYER"	"SHAPE"	"OBJTYPE")
      addMRIN	 '(("Tagstring" "MRIN")("TextString" "")( "PromptString""Enter MRIN."))
      attdefProp '( "StyleName" "Layer" "Height" "Mode" "PromptString" "InsertionPoint" "Tagstring" "TextString"  )
)
(setq blockCollection (vla-get-blocks
			(vla-get-ActiveDocument (vlax-get-acad-object))
			)
      )  
(while (setq a (tblnext "BLOCK" (null a)))
	  (if (and (equal '(70 . 2)(assoc 70 a))
		   (wcmatch  (Setq blockName (Cdr (assoc 2 a))) "*$ECC$*"))
	    		(progn
	    		    (vlax-for blockObjects (setq forAttsync (vla-item blockCollection blockName))
				  	(If (eq (vla-get-ObjectName blockObjects) "AcDbAttributeDefinition")
						  (setq attrFromBlock (Cons
								(list blockObjects
									(mapcar '(lambda (x)
									     (list x (vlax-get-property blockObjects x)))
									  attdefProp
										  )
								      ) attrFromBlock
									)
					  			)						
						    )
			      )
			  (Cond
			    ((vl-some '(lambda (j)(member (Car addMRIN) j))(mapcar 'cadr attrFromBlock))
			     )
			    ((vl-every 'eval
				       (mapcar 'cadr
					       (setq attData (mapcar '(lambda (d)
									(assoc d (apply 'append (mapcar 'Cadr attrFromBlock)))
								      )
								     attdefProp
							     )
					       )
				       )
			     )
			     (mapcar 'vla-delete (mapcar 'car attrFromBlock))
			     
				   (setq  attrFromBlock (Cons (mapcar '(lambda (rep)
							   (if (setq f (assoc (Car rep) addMRIN)) f rep)) attData)
							      (mapcar 'cadr attrFromBlock)))
				  (mapcar (function
				      (lambda (tn)
					(Setq lst (Vl-some '(lambda (tmn)
							    (if (member (list "Tagstring" tn) tmn) tmn))  attrFromBlock))
					(Setq newAttb (vl-catch-all-apply 'vla-AddAttribute (cons forAttsync  (mapcar 'cadr (cddr lst)))))
					(Vlax-put newAttb (Caar lst)(Cadar lst))
					(Vlax-put newAttb (caadr lst)(Cadadr lst)) TN)) tagNames)
			     (setq blockNameCollection (cons blockName blockNameCollection))		     
			     )
			    )
			  (setq attrFromBlock nil)
			  )
	    )
    )

  (and blockNameCollection
       (princ "\nMRIN Tag added to block(s)")
       (Foreach	bnameSync blockNameCollection
	 (command "_.attsync" "Name" bnameSync)
	 (princ (strcat " : " bnameSync))
       )
  )
  (princ)
  )

Command: WEDGIE
MRIN Tag added to block(s)
ATTSYNC complete. : MissingAtt$ECC$2

HTH

pbejse · ‎07-21-2024

@Sea-Haven wrote:

Thank you for this @Sea-Haven

stev98312 · ‎07-21-2024

@pbejse

I'm not well schooled in Design Center. I'll be spending some time there investigating its capabilities.

-HOWEVER-

The rehash of your code to make the aptly named Wedgie program was the very thing!
Considerable testing this morning and it worked prefectly in every instance.
And the list of block numbers corrected is just icing on this cake!
I can't ask for more than that. I had a big grin on my face while testing this.
Hours of work per drawing has been reduced to under a second with this program.
Thank you for sharing your programming expertise.
Cheers and Beers!

Steve