Jump to content

Insert block attribute into text field

ordengate

By ordengate
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

ordengate Apprentice

ordengate

Posted
Posted

I'm trying to take a block that has an attribute and 'tag' it with an mtext text field to be used with the eattext command. I cannot for the life of me figure out how to do this. Can anyone give me some pointers?

 

It gets old when you have 100 blocks and have to manually insert a text field next to it.

BIGAL Grand Master

BIGAL

Posted
Posted

Theres no problem to pull an attribute value out of a block and then write it as mtext, search here for a recent problem "getting 4th attribute" Lee mac and AlanJT have some extensive block routines posted here and I have posted an example soloution getting attributes using VBA multi times.

 

Sounds like you didn't do a search first.

alanjt Grand Master

alanjt

Posted
Posted
Sounds like you didn't do a search first.
Sadly, few ever do.
fixo Mentor

fixo

Posted
Posted
I'm trying to take a block that has an attribute and 'tag' it with an mtext text field to be used with the eattext command. I cannot for the life of me figure out how to do this. Can anyone give me some pointers?

 

It gets old when you have 100 blocks and have to manually insert a text field next to it.

Welcome on board!

Try this quick example

 
(vl-load-com)
(defun C:MField(/ acsp atts blk_obj ent found id pt tag)
 (while (setq ent (entsel "\nSelect block instance (or press Enter to Exit): "))
   (setq blk_obj (vlax-ename->vla-object (car ent)))
   (setq tag (getstring "\nEnter tag <MODIF_A> : "));<--change on appropriate tag here
   (if (eq (chr 0) tag)
     (setq tag "MODIF_A"));<--change on appropriate tag here

   (setq atts (vlax-invoke blk_obj 'getattributes))
   (foreach att atts
     (if (eq (vla-get-tagstring att) tag)
(progn
(setq found (vla-get-textstring att))
(setq id (vla-get-objectid att))
       (setq pt (getpoint "\nPick a  field location >> "))
       (setq acsp (vla-get-block
  (vla-get-activelayout
    (vla-get-activedocument
      (vlax-get-acad-object))))
  )

  (vlax-invoke-method acsp 'addmtext (vlax-3d-point pt) 0.0
  (strcat  "%<[url="file://acobjprop/"]\\AcObjProp[/url] Object(%<[url="file://_objid/"]\\_ObjId[/url] " (itoa id) ">%).TextString [url="file://f/"]\\f[/url] \"%tc4\">%"));<--\"%tc4\" is title case, you can remove it
   )
)
     )
   )
 (princ)
 )

 

~'J'~

ordengate Apprentice

ordengate

Posted
  • Author
Posted

That will definitely get me started. Thank you so much. Is there a guide for VLA programming in LISP I can read to try and reproduce this on other things? Also, sorry I didn't do a search. Generally I use google to search multiple sites and after checking 10 pages trying to figure this out, I gave up and posted on here.

ordengate Apprentice

ordengate

Posted
  • Author
Posted

One other question: How do I set the justification?

 

I found this snippet on another thread, but I can't seem to work it in

 

(vlax-put mtxtobj 'AttachmentPoint acAttachmentPointMiddleCenter)

 

Ultimately I'd like one command for each of the nine justifications. Otherwise the version I've reworked from your code works wonderfully.

fixo Mentor

fixo

Posted
Posted (edited)
That will definitely get me started. Thank you so much. Is there a guide for VLA programming in LISP I can read to try and reproduce this on other things? Also, sorry I didn't do a search. Generally I use google to search multiple sites and after checking 10 pages trying to figure this out, I gave up and posted on here.

 

This is my favourite web site

http://www.afralisp.net/visual-lisp/

the best one, IMHO

 

You can also download VisulLisp Developer Bible.pdf from there

http://sites.google.com/site/visuallispbible/downloads

 

~'J'~

Edited by fixo
fixo Mentor

fixo

Posted
Posted
One other question: How do I set the justification?

 

I found this snippet on another thread, but I can't seem to work it in

 

(vlax-put mtxtobj 'AttachmentPoint acAttachmentPointMiddleCenter)

 

Ultimately I'd like one command for each of the nine justifications. Otherwise the version I've reworked from your code works wonderfully.

 

After you've changed the Attachment point property of mtext object, you

need to put insertion point back:

 
(setq inspt (vla-get-insertionpoint mtxtobj))
(vla-put-attachmentpoint mtxtobj acAttachmentPointMiddleCenter)
(vla-put-insertionpoint mtxtobj inspt)

 

~'J'~

ordengate Apprentice

ordengate

Posted
  • Author
Posted
After you've changed the Attachment point property of mtext object, you

need to put insertion point back:

 
(setq inspt (vla-get-insertionpoint mtxtobj))
(vla-put-attachmentpoint mtxtobj acAttachmentPointMiddleCenter)
(vla-put-insertionpoint mtxtobj inspt)

 

~'J'~

 

I've tried adding that bit to the code you gave me previously, but it's still putting the justification point at the top left. I'm eventually going to want to offset the text as well. My original code to do that was as follows:

 

(DEFUN MTTL ()
(SETVAR "CMDECHO" 0)
(SETQ SCALE (/ 1 (GETVAR "CANNOSCALEVALUE")))
(SETQ MTPOINT (GETPOINT "\NENTER JUSTIFICATION POINT: "))
(SETQ MTHEIGHT (* SCALE 0.078125))
(SETQ MTX (+ (CAR MTPOINT) (* SCALE 0.03125)))
(SETQ MTY (- (CADR MTPOINT) (* SCALE 0.0390625)))
(COMMAND "MTEXT" (LIST MTX MTY) "J" "TL" "H" MTHEIGHT "R" "0" "W" "0" V:TEXT "")
(SETVAR "CMDECHO" 1)
)

 

Is this something I can do to the insertion point?

fixo Mentor

fixo

Posted
Posted (edited)
I've tried adding that bit to the code you gave me previously, but it's still putting the justification point at the top left. I'm eventually going to want to offset the text as well. My original code to do that was as follows:

 

(DEFUN MTTL ()
(SETVAR "CMDECHO" 0)
(SETQ SCALE (/ 1 (GETVAR "CANNOSCALEVALUE")))
(SETQ MTPOINT (GETPOINT "\NENTER JUSTIFICATION POINT: "))
(SETQ MTHEIGHT (* SCALE 0.078125))
(SETQ MTX (+ (CAR MTPOINT) (* SCALE 0.03125)))
(SETQ MTY (- (CADR MTPOINT) (* SCALE 0.0390625)))
(COMMAND "MTEXT" (LIST MTX MTY) "J" "TL" "H" MTHEIGHT "R" "0" "W" "0" V:TEXT "")
(SETVAR "CMDECHO" 1)
)

 

Is this something I can do to the insertion point?

 

Sorry, I was a bit busy with my own

This code is working good on my machine (I used A2009)

Try again

 
(vl-load-com)
(defun C:MField(/ acsp atts blk_obj ent found id pt tag)
 (while (setq ent (entsel "\nSelect block instance (or press Enter to Exit): "))
   (setq blk_obj (vlax-ename->vla-object (car ent)))
   (setq tag (getstring "\nEnter tag <MODIF_A> : "));<--change on appropriate tag here
   (if (eq (chr 0) tag)
     (setq tag "MODIF_A"));<--change on appropriate tag here

   (setq atts (vlax-invoke blk_obj 'getattributes))
   (foreach att atts
     (if (eq (vla-get-tagstring att) tag)
(progn
(setq found (vla-get-textstring att))
(setq id (vla-get-objectid att))
       (setq pt (getpoint "\nSpecify a field location >> "))
       (setq acsp (vla-get-block
  (vla-get-activelayout
    (vla-get-activedocument
      (vlax-get-acad-object))))
  )

  (setq mtxtobj (vlax-invoke-method acsp 'addmtext (vlax-3d-point pt) 0.0
  (strcat  "%<[url="file://acobjprop/"]\\AcObjProp[/url] Object(%<[url="file://_objid/"]\\_ObjId[/url] " (itoa id) ">%).TextString [url="file://f/"]\\f[/url] \"%tc4\">%")))
  (vla-put-attachmentpoint mtxtobj acAttachmentPointMiddleCenter)
  (vla-put-insertionpoint mtxtobj (vlax-3d-point pt)) 
   )
)
     )
   )
 (princ)
 )

 

~'J'~

Edited by fixo
spell check
ordengate Apprentice

ordengate

Posted
  • Author
Posted

Finished product for anyone interested. Thanks again for the help.

(vl-load-com)

(DEFUN C:TID ()
(SETQ V:JUST "TL")
(SETQ	V:JUST (GETSTRING "Justification: (TL,TC,TR,ML,MC,MR,BL,BC,BR) <TL>: "))
(IF (OR (= "TL" V:JUST)	(= "tl" V:JUST)	(= "" V:JUST))	(INSIDTL)	(PRINC))
(IF (OR (= "TC" V:JUST)	(= "tc" V:JUST))								(INSIDTC)	(PRINC))
(IF (OR (= "TR" V:JUST)	(= "tr" V:JUST))								(INSIDTR)	(PRINC))
(IF (OR (= "ML" V:JUST)	(= "ml" V:JUST))								(INSIDML)	(PRINC))
(IF (OR (= "MC" V:JUST)	(= "mc" V:JUST))								(INSIDMC)	(PRINC))
(IF (OR (= "MR" V:JUST)	(= "mr" V:JUST))								(INSIDMR)	(PRINC))
(IF (OR (= "BL" V:JUST)	(= "bl" V:JUST))								(INSIDBL)	(PRINC))
(IF (OR (= "BC" V:JUST)	(= "bc" V:JUST))								(INSIDBC)	(PRINC))
(IF (OR (= "BR" V:JUST)	(= "br" V:JUST))								(INSIDBR)	(PRINC))
)

(DEFUN C:TCIRC ()
(SETQ V:JUST "TL")
(SETQ	V:JUST (GETSTRING "Justification: (TL,TC,TR,ML,MC,MR,BL,BC,BR) <TL>: "))
(IF (OR (= "TL" V:JUST)	(= "tl" V:JUST)	(= "" V:JUST))	(INSCIRCTL)	(PRINC))
(IF (OR (= "TC" V:JUST)	(= "tc" V:JUST))								(INSCIRCTC)	(PRINC))
(IF (OR (= "TR" V:JUST)	(= "tr" V:JUST))								(INSCIRCTR)	(PRINC))
(IF (OR (= "ML" V:JUST)	(= "ml" V:JUST))								(INSCIRCML)	(PRINC))
(IF (OR (= "MC" V:JUST)	(= "mc" V:JUST))								(INSCIRCMC)	(PRINC))
(IF (OR (= "MR" V:JUST)	(= "mr" V:JUST))								(INSCIRCMR)	(PRINC))
(IF (OR (= "BL" V:JUST)	(= "bl" V:JUST))								(INSCIRCBL)	(PRINC))
(IF (OR (= "BC" V:JUST)	(= "bc" V:JUST))								(INSCIRCBC)	(PRINC))
(IF (OR (= "BR" V:JUST)	(= "br" V:JUST))								(INSCIRCBR)	(PRINC))
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun INSIDTL(/ acsp atts blk_obj ent found id pt tag)
(while (setq ent (entsel "\nSelect block instance (or press Enter to Exit): "))
	(setq blk_obj (vlax-ename->vla-object (car ent)))
	(Setq tag "ID")
	(if (eq (chr 0) tag)
	(setq tag "ID"))
	(setq atts (vlax-invoke blk_obj 'getattributes))
	(foreach att atts
		(if (eq (vla-get-tagstring att) tag)
			(progn
				(setq found (vla-get-textstring att))
				(setq id (vla-get-objectid att))
				(setq pt (getpoint "\nPick a  field location: "))
				(setq acsp (vla-get-block
					(vla-get-activelayout
					(vla-get-activedocument
					(vlax-get-acad-object))))
				)
				(setq mtxtobj (vlax-invoke-method acsp 'addmtext (vlax-3d-point pt) 0.0
					(strcat  "%<\\AcObjProp Object(%<\\_ObjId " (itoa id) ">%).TextString \\f \"%tc4\">%"))
				)
				(vla-put-attachmentpoint mtxtobj acAttachmentPointTopLeft)
				(vla-put-insertionpoint mtxtobj (vlax-3d-point pt))
			)
		)
	)
)
(princ)
)

(defun INSIDTC(/ acsp atts blk_obj ent found id pt tag)
(while (setq ent (entsel "\nSelect block instance (or press Enter to Exit): "))
	(setq blk_obj (vlax-ename->vla-object (car ent)))
	(Setq tag "ID")
	(if (eq (chr 0) tag)
	(setq tag "ID"))
	(setq atts (vlax-invoke blk_obj 'getattributes))
	(foreach att atts
		(if (eq (vla-get-tagstring att) tag)
			(progn
				(setq found (vla-get-textstring att))
				(setq id (vla-get-objectid att))
				(setq pt (getpoint "\nPick a  field location: "))
				(setq acsp (vla-get-block
					(vla-get-activelayout
					(vla-get-activedocument
					(vlax-get-acad-object))))
				)
				(setq mtxtobj (vlax-invoke-method acsp 'addmtext (vlax-3d-point pt) 0.0
					(strcat  "%<\\AcObjProp Object(%<\\_ObjId " (itoa id) ">%).TextString \\f \"%tc4\">%"))
				)
				(vla-put-attachmentpoint mtxtobj acAttachmentPointTopCenter)
				(vla-put-insertionpoint mtxtobj (vlax-3d-point pt))
			)
		)
	)
)
(princ)
)

(defun INSIDTR(/ acsp atts blk_obj ent found id pt tag)
(while (setq ent (entsel "\nSelect block instance (or press Enter to Exit): "))
	(setq blk_obj (vlax-ename->vla-object (car ent)))
	(Setq tag "ID")
	(if (eq (chr 0) tag)
	(setq tag "ID"))
	(setq atts (vlax-invoke blk_obj 'getattributes))
	(foreach att atts
		(if (eq (vla-get-tagstring att) tag)
			(progn
				(setq found (vla-get-textstring att))
				(setq id (vla-get-objectid att))
				(setq pt (getpoint "\nPick a  field location: "))
				(setq acsp (vla-get-block
					(vla-get-activelayout
					(vla-get-activedocument
					(vlax-get-acad-object))))
				)
				(setq mtxtobj (vlax-invoke-method acsp 'addmtext (vlax-3d-point pt) 0.0
					(strcat  "%<\\AcObjProp Object(%<\\_ObjId " (itoa id) ">%).TextString \\f \"%tc4\">%"))
				)
				(vla-put-attachmentpoint mtxtobj acAttachmentPointTopRight)
				(vla-put-insertionpoint mtxtobj (vlax-3d-point pt))
			)
		)
	)
)
(princ)
)

(defun INSIDML(/ acsp atts blk_obj ent found id pt tag)
(while (setq ent (entsel "\nSelect block instance (or press Enter to Exit): "))
	(setq blk_obj (vlax-ename->vla-object (car ent)))
	(Setq tag "ID")
	(if (eq (chr 0) tag)
	(setq tag "ID"))
	(setq atts (vlax-invoke blk_obj 'getattributes))
	(foreach att atts
		(if (eq (vla-get-tagstring att) tag)
			(progn
				(setq found (vla-get-textstring att))
				(setq id (vla-get-objectid att))
				(setq pt (getpoint "\nPick a  field location: "))
				(setq acsp (vla-get-block
					(vla-get-activelayout
					(vla-get-activedocument
					(vlax-get-acad-object))))
				)
				(setq mtxtobj (vlax-invoke-method acsp 'addmtext (vlax-3d-point pt) 0.0
					(strcat  "%<\\AcObjProp Object(%<\\_ObjId " (itoa id) ">%).TextString \\f \"%tc4\">%"))
				)
				(vla-put-attachmentpoint mtxtobj acAttachmentPointMiddleLeft)
				(vla-put-insertionpoint mtxtobj (vlax-3d-point pt))
			)
		)
	)
)
(princ)
)

(defun INSIDMC(/ acsp atts blk_obj ent found id pt tag)
(while (setq ent (entsel "\nSelect block instance (or press Enter to Exit): "))
	(setq blk_obj (vlax-ename->vla-object (car ent)))
	(Setq tag "ID")
	(if (eq (chr 0) tag)
	(setq tag "ID"))
	(setq atts (vlax-invoke blk_obj 'getattributes))
	(foreach att atts
		(if (eq (vla-get-tagstring att) tag)
			(progn
				(setq found (vla-get-textstring att))
				(setq id (vla-get-objectid att))
				(setq pt (getpoint "\nPick a  field location: "))
				(setq acsp (vla-get-block
					(vla-get-activelayout
					(vla-get-activedocument
					(vlax-get-acad-object))))
				)
				(setq mtxtobj (vlax-invoke-method acsp 'addmtext (vlax-3d-point pt) 0.0
					(strcat  "%<\\AcObjProp Object(%<\\_ObjId " (itoa id) ">%).TextString \\f \"%tc4\">%"))
				)
				(vla-put-attachmentpoint mtxtobj acAttachmentPointMiddleCenter)
				(vla-put-insertionpoint mtxtobj (vlax-3d-point pt))
			)
		)
	)
)
(princ)
)

(defun INSIDMR(/ acsp atts blk_obj ent found id pt tag)
(while (setq ent (entsel "\nSelect block instance (or press Enter to Exit): "))
	(setq blk_obj (vlax-ename->vla-object (car ent)))
	(Setq tag "ID")
	(if (eq (chr 0) tag)
	(setq tag "ID"))
	(setq atts (vlax-invoke blk_obj 'getattributes))
	(foreach att atts
		(if (eq (vla-get-tagstring att) tag)
			(progn
				(setq found (vla-get-textstring att))
				(setq id (vla-get-objectid att))
				(setq pt (getpoint "\nPick a  field location: "))
				(setq acsp (vla-get-block
					(vla-get-activelayout
					(vla-get-activedocument
					(vlax-get-acad-object))))
				)
				(setq mtxtobj (vlax-invoke-method acsp 'addmtext (vlax-3d-point pt) 0.0
					(strcat  "%<\\AcObjProp Object(%<\\_ObjId " (itoa id) ">%).TextString \\f \"%tc4\">%"))
				)
				(vla-put-attachmentpoint mtxtobj acAttachmentPointMiddleRight)
				(vla-put-insertionpoint mtxtobj (vlax-3d-point pt))
			)
		)
	)
)
(princ)
)

(defun INSIDBL(/ acsp atts blk_obj ent found id pt tag)
(while (setq ent (entsel "\nSelect block instance (or press Enter to Exit): "))
	(setq blk_obj (vlax-ename->vla-object (car ent)))
	(Setq tag "ID")
	(if (eq (chr 0) tag)
	(setq tag "ID"))
	(setq atts (vlax-invoke blk_obj 'getattributes))
	(foreach att atts
		(if (eq (vla-get-tagstring att) tag)
			(progn
				(setq found (vla-get-textstring att))
				(setq id (vla-get-objectid att))
				(setq pt (getpoint "\nPick a  field location: "))
				(setq acsp (vla-get-block
					(vla-get-activelayout
					(vla-get-activedocument
					(vlax-get-acad-object))))
				)
				(setq mtxtobj (vlax-invoke-method acsp 'addmtext (vlax-3d-point pt) 0.0
					(strcat  "%<\\AcObjProp Object(%<\\_ObjId " (itoa id) ">%).TextString \\f \"%tc4\">%"))
				)
				(vla-put-attachmentpoint mtxtobj acAttachmentPointBottomLeft)
				(vla-put-insertionpoint mtxtobj (vlax-3d-point pt))
			)
		)
	)
)
(princ)
)

(defun INSIDBC(/ acsp atts blk_obj ent found id pt tag)
(while (setq ent (entsel "\nSelect block instance (or press Enter to Exit): "))
	(setq blk_obj (vlax-ename->vla-object (car ent)))
	(Setq tag "ID")
	(if (eq (chr 0) tag)
	(setq tag "ID"))
	(setq atts (vlax-invoke blk_obj 'getattributes))
	(foreach att atts
		(if (eq (vla-get-tagstring att) tag)
			(progn
				(setq found (vla-get-textstring att))
				(setq id (vla-get-objectid att))
				(setq pt (getpoint "\nPick a  field location: "))
				(setq acsp (vla-get-block
					(vla-get-activelayout
					(vla-get-activedocument
					(vlax-get-acad-object))))
				)
				(setq mtxtobj (vlax-invoke-method acsp 'addmtext (vlax-3d-point pt) 0.0
					(strcat  "%<\\AcObjProp Object(%<\\_ObjId " (itoa id) ">%).TextString \\f \"%tc4\">%"))
				)
				(vla-put-attachmentpoint mtxtobj acAttachmentPointBottomCenter)
				(vla-put-insertionpoint mtxtobj (vlax-3d-point pt))
			)
		)
	)
)
(princ)
)

(defun INSIDBR(/ acsp atts blk_obj ent found id pt tag)
(while (setq ent (entsel "\nSelect block instance (or press Enter to Exit): "))
	(setq blk_obj (vlax-ename->vla-object (car ent)))
	(Setq tag "ID")
	(if (eq (chr 0) tag)
	(setq tag "ID"))
	(setq atts (vlax-invoke blk_obj 'getattributes))
	(foreach att atts
		(if (eq (vla-get-tagstring att) tag)
			(progn
				(setq found (vla-get-textstring att))
				(setq id (vla-get-objectid att))
				(setq pt (getpoint "\nPick a  field location: "))
				(setq acsp (vla-get-block
					(vla-get-activelayout
					(vla-get-activedocument
					(vlax-get-acad-object))))
				)
				(setq mtxtobj (vlax-invoke-method acsp 'addmtext (vlax-3d-point pt) 0.0
					(strcat  "%<\\AcObjProp Object(%<\\_ObjId " (itoa id) ">%).TextString \\f \"%tc4\">%"))
				)
				(vla-put-attachmentpoint mtxtobj acAttachmentPointBottomRight)
				(vla-put-insertionpoint mtxtobj (vlax-3d-point pt))
			)
		)
	)
)
(princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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...