TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: deerailed77 on April 14, 2016, 05:57:48 PM
-
I am looking for a lisp routine that will work with a attribute block that has tag names the same but the prompts are different.
example the first 12 are all tags and prompts different but then at 13 they start repeating every 6 I know there is a way its long but can be done. used to have one that I could have used but no longer at that company where I had it. Plus it was about 10 years ago, currently using 2015 electrical.
the block name is val_snc_bdr due to corporate reasons I am unable to post the actual file. gotta love corporate america. LOL
example
tag prompt
REV rev1
DATE date1
DESC desc1
CAD cad1
CHKD chkd1
APP app2
REV rev2
DATE date2
DESC desc2
CAD cad2
CHKD chkd2
APP app2
-
Literally have no idea what you are asking
-
I have an attributed block that was created that uses the same tag name for multiple attributes. I need to be able to select say the second one and input the revision number, date, description, cad, chkd, and approved via a lisp.
and then i can edit that one to work for the 3rd row, 4th and so on as needed.
If the idiots that created this block wouldnt have just copied the text and actually gave it a individual value I would be ok.
-
heres an example of the attribute
-
Maybe you could sort them by insertion point & Y values.
-
I would suggest iterating over the block definition and pairing the attribute tags with their respective prompts, and then using such prompts to obtain the appropriate attribute reference to modify.
-
(defun c:MyEd ( / _SortAttribsByXY _IsAttributedBlock _Main )
;; Written very quick & dirty for the swamp. Has bugs and
;; communicable diseases, use at your own risk.
;;
;; Relies on DOSLIB (http://wiki.mcneel.com/doslib/home)
(defun _SortAttribsByXY ( attribs / fuzz lst a y groups )
;; First get the fuzz factor, let's make it a function
;; of the height of the first attrib.
(setq fuzz (* 0.75 (vla-get-height (car attribs))))
;; Since we'll be querying the coordinate data a couple
;; times it makes sence to cache it.
(setq lst
(mapcar
(function
(lambda ( a / p )
(list
(car (setq p (vlax-get a 'InsertionPoint)))
(cadr p)
a
)
)
)
attribs
)
)
;; Initialize the grouping using the first attribute.
(setq groups (list (vl-list* (cadr (setq a (car lst))) a nil)))
;; Ok. First group the attribs by their y ord.
(foreach a (cdr lst)
(setq y (cadr a))
(if
(null
(vl-some
(function
(lambda ( g / y! )
(if (equal y (setq y! (car g)) fuzz)
(setq groups
(subst
(vl-list* y! a (cdr g))
g
groups
)
)
)
)
)
groups
)
)
(setq groups (cons (vl-list* y a nil) groups))
)
)
;; Sort the groups by the y ord, large to small.
(setq groups
(vl-sort
groups
(function (lambda ( a b ) (> (car a) (car b))))
)
)
;; Now sort each group by its members x ord, small to large.
(setq groups
(mapcar
(function
(lambda ( g )
(vl-sort g (function (lambda ( a b ) (< (car a) (car b)))))
)
)
(mapcar 'cdr groups)
)
)
;; Ok, dispence with the grouping and lose the ordinate
;; info, return to caller.
(mapcar 'last (apply 'append groups))
)
(defun _IsAttributedBlock ( object )
(cond
( (null (eq "AcDbBlockReference" (vla-get-objectname object)))
(princ "\nNot a block insert.")
nil
)
( (null (eq :vlax-true (vla-get-hasattributes object)))
(princ "\nBlock has no attributes.")
nil
)
(t)
)
)
(defun _Main ( / doc ename object attribs name result new )
(cond
( (progn
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
nil
)
)
( (null dos_proplist)
(princ
(strcat
"\nDo yourself a solid. Download & install DOSLIB."
"\tAvailable at http://wiki.mcneel.com/doslib/home."
)
)
)
( (while (setq ename (car (entsel)))
(if
(and
(_IsAttributedBlock (setq object (vlax-ename->vla-object ename)))
(setq
attribs (vlax-invoke object 'GetAttributes)
name (vla-get-name object)
)
(setq attribs
(mapcar
(function
(lambda ( a )
(list
(vla-get-tagstring a)
(vla-get-textstring a)
a
)
)
)
(_SortAttribsByXY attribs)
)
)
(setq result
(dos_proplist "MyEd" (strcat name ":")
(mapcar
(function (lambda ( a ) (cons (car a) (cadr a))))
attribs
)
)
)
)
(foreach lst (mapcar 'list result attribs)
(if
(/=
(setq new (cdar lst))
(cadr (cadr lst))
)
(vla-put-textstring (last (cadr lst)) new)
)
)
)
)
)
)
(princ)
)
(_Main)
)
-
(defun c:MyEd ( / _GetAttDefs _SortAttribsByXY _Main )
< ... >
Good Example. But have a few flaws.
If attribute block no prompt .will Error.
in addition. when change attribute Value complete . princ "Oh my, nothing to do".It is right ?
edit:kdub -> errant code removed as requested
-
Thank you for trying the program and reporting the problems AIberto.
Fixed in my original post.
An aside, it appears there's a bug in DOSLIB revealed by the first version of the program.
Observe:
(dos_proplist "Title" "Description" '(("Prompt" . "Value")))
>> (("Prompt" . "Changed_Value")) [good]
(dos_proplist "Title" "Description" '(("" . "Value")))
>> ("Changed_Value") [not good]
The function strips the prompt and fubars the list nesting if a prompt is an empty string.
I substituted (chr 160) <non-breaking space> where the prompt string is empty, that seems to remedy it. A one space " " string will suffice too but (chr 160) is explicit in its intention, ergo my use.
Thanks & cheers.
PS: Could you remove the errant code you quoted in your post? Thx.
-
This thread made me think -- is there an easy way to view / modify attribute prompts en masse?
BEdit is not the answer.
Perhaps this is:
(defun c:Prompter ( / _Try _GetBlockDefAttDefInfo _Main )
;; C:Prompter. Change the prompts for the selected block.
;;
;; Trivial code but still © 2016 Michael Puckett.
;;
;; Version 1. 2016-04-17.
;;
;; Written very quick & dirty for the swamp. Has bugs and
;; communicable diseases, use at your own risk.
;;
;; Relies on DOSLIB (http://wiki.mcneel.com/doslib/home)
(defun _Try ( try_statement / try_result )
(vl-catch-all-apply
(function
(lambda ( )
(setq try_result (eval try_statement))
)
)
)
try_result
)
(defun _GetBlockDefAttDefInfo ( doc )
( (lambda ( :GetAttDefs / result )
(vlax-for block (vla-get-blocks doc)
(and
(eq :vlax-false (vla-get-isxref block))
(eq :vlax-false (vla-get-islayout block))
(setq name (_Try '(vla-get-name block)))
(wcmatch name "~`**")
(setq attdefs (:GetAttDefs block))
(setq result (cons (cons name attdefs) result))
)
)
(vl-sort result (function (lambda (a b) (< (car a) (car b)))))
)
(lambda ( block / result )
(vlax-for object block
(and
(eq "AcDbAttributeDefinition" (vla-get-objectname object))
(eq :vlax-false (vla-get-constant object))
(setq result
(cons
(list
(vla-get-tagstring object)
(vla-get-promptstring object)
object
)
result
)
)
)
)
(reverse result)
)
)
)
(defun _Main ( / doc BlockDefAttDefInfo next_time name new changes )
(cond
( (null dos_proplist)
(princ
(strcat
"\nDo yourself a solid. Download & install DOSLIB."
"\tAvailable at http://wiki.mcneel.com/doslib/home."
)
)
)
( (progn (vl-load-com) nil))
( (null (setq doc (vla-get-activedocument (vlax-get-acad-object)))))
( (null (setq BlockDefAttDefInfo (_GetBlockDefAttDefInfo doc)))
(princ "\nNo attributed block defs in this drawing.")
)
( (null (setq next_time "\nNothing to do, maybe next time.")))
( (null
(setq name
(dos_listbox
"Prompter"
"Select an attributed block to modify:"
(mapcar 'car BlockDefAttDefInfo)
)
)
)
(princ next_time)
)
( (setq result
(dos_proplist "Prompter" "Modify Attribute Prompts:"
(mapcar
(function (lambda ( a ) (cons (car a) (cadr a))))
(setq data (cdr (assoc name BlockDefAttDefInfo)))
)
)
)
(foreach lst (mapcar 'list result data)
(if
(/=
(setq new (cdar lst))
(cadr (cadr lst))
)
(progn
(vla-put-promptstring (last (cadr lst)) new)
(princ (strcat "\n" (caar lst) " prompt changed to [\"" new "\"]"))
(setq changes T)
)
)
)
(if (null changes) (princ next_time))
)
( (princ next_time))
)
(princ)
)
(_Main)
)
Let me know if it works, fails, other.
Cheers.
-
One of the problems has always been the ability to modify/edit/remove/add ATTRIButes in the INSERT so that they do match the ATTDEFs in the BLOCK table definition. DDATTE looks at the BLOCK table for prompts but the INSERT for the data. -David
-
Strange structure:
Why not?:
-
@David: Yep. I understand why they did it that way (data efficiency et al) but may not have been the best implementation. If one is manually adding attributes to block insertions one has to be mindful of the block def's sequencing.
@Roy: Lotsa ways to skin the cat, meow. I like strange.
-
Hi MP
If "prompt" is empty , that still will be error :
Select object: ; error: Unknown exception occurred
; warning: unwind skipped on unknown exception
Create an attribute block. The tag cannot be empty. the prompt can be empty.
-
Can you post a sample drawing? The program works on the sample dwgs I have that sport attributed blocks with promptless attdefs. Thanks.
-
Can you post a sample drawing? The program works on the sample dwgs I have that sport attributed blocks with promptless attdefs. Thanks.
In attachment . Just an attribute block without "prompt"
command: MyEd
Select object: ; error: Unknown exception occurred
; warning: unwind skipped on unknown exception
-
Thanks AIberto. Could you (or someone else) perform a "SaveAs" down to 2010 format?
I only have AutoCAD 2012 here and no TrueView install.
Thanks and sorry (I should have specified).
-
Thanks AIberto. Could you (or someone else) perform a "SaveAs" down to 2010 format?
I only have AutoCAD 2012 here and no TrueView install.
Thanks and sorry (I should have specified).
I'm sorry , MP ,I forgot converted.
-
Sorry AIberto but that's still a 2013 version dwg.
-
Sorry AIberto but that's still a 2013 version dwg.
Here you go :)
-
Thanks Ronjonp.
Both programs work on the sample drawing without incident.
¯\_(ツ)_/¯
-
Thanks Ronjonp.
Both programs work on the sample drawing without incident.
¯\_(ツ)_/¯
I use different PC, different CAD version (2013, 2010) for test . the same error.
-
Don't know what to tell you, cannot replicate the error here.
Can anyone else replicate the error? Thanks & cheers.
-
Tested here on 2013 ITA, MyEd & Prompter: OK :-)
-
Thank you for testing and attesting sir. :-)
-
I use acad2010 ,windows XP sp3 , DOSLib18.arx,
Break at:
(dos_proplist "MyEd" "Modify Attributes"
(mapcar
(function (lambda ( a ) (cons (car a) (cadr a))))
attribs
)
)
Tested here on 2013 ITA, MyEd & Prompter: OK :-)
mean: if "prompt" is empty . must use other routine "c:Prompter" to modify attribute prompts , make it not empty . Then use "Myed" ?
-
Tested here on 2013 ITA, MyEd & Prompter: OK :-)
mean: if "prompt" is empty . must use other routine "c:Prompter" to modify attribute prompts , make it not empty . Then use "Myed" ?
No, I used MyEd & Prompter on your file just opened and not modified in two different sessions and loading only one function at a time... :yes:
-
Tested here on 2013 ITA, MyEd & Prompter: OK :-)
mean: if "prompt" is empty . must use other routine "c:Prompter" to modify attribute prompts , make it not empty . Then use "Myed" ?
No, I used MyEd & Prompter on your file just opened and not modified in two different sessions and loading only one function at a time... :yes:
Dear sir.
I testing. Break at:
(dos_proplist "MyEd" "Modify Attributes"
(mapcar
(function (lambda ( a ) (cons (car a) (cadr a))))
attribs
)
)
You analyze why appear error ?
-
Hi AIberto.
- While MyEd and Prompter both work with some aspect of attributes they are fully independent.
- Is DOSLIB (http://wiki.mcneel.com/doslib/home) installed and loaded?
- Define and load this error handler: (defun *error* (m) (vl-bt)).
- Execute the program and post the error messages you see.
-
Hi AIberto.
- While MyEd and Prompter both work with some aspect of attributes they are fully independent.
- Is DOSLIB (http://wiki.mcneel.com/doslib/home) installed and loaded?
- Define and load this error handler: (defun *error* (m) (vl-bt)).
- Execute the program and post the error messages you see.
windos xp 32bit+ acad2010 +doslib18.arx
DOSLib18.arx successfully loaded.
Command: myed
Select object: ; error: Unknown exception occurred
; warning: unwind skipped on unknown exception
Command: (defun *error* (m) (vl-bt))
*ERROR*
-
Sorry, unless you provide more info I can't help you.
-
Sorry, unless you provide more info I can't help you.
Dear MP
I invited a friend to help me test , He is a Lisp Master. At his side. Still Error .
-
if prompt is empty , test Error.
if prompt is not empty .test ok!
-
Have LISP master substitute "-" instead of (chr 160).
-
Have LISP master substitute "-" instead of (chr 160).
Dear MP ,I can't understand. :-(
-
I'd assume Michael means :
Change this :
(defun _GetPrompt
( attrib
/ result
) result
)
)
to this :
(defun _GetPrompt
( attrib
/ result
) ;;("-") fix error:kdub
"-"
result
)
)
note : I haven't followed the complete thread so I may be incorrect.
edit:repair error
-
Yes + thanks. I'm at work and cannot play.
-
Actually "-", not ("-"). Missed as I'm viewing on my diminutive phone. Thx KB.
-
Strange... to me it works without any modification, if I add a print before dos_proplist:
...
(print
(mapcar
(function (lambda ( a ) (cons (car a) (cadr a))))
attribs
)
)
(setq result
(dos_proplist "MyEd" "Modify Attributes"
(mapcar
(function (lambda ( a ) (cons (car a) (cadr a))))
attribs
)
)
)
...
(defun _GetPrompt ( attrib / result )
(if (eq "" (setq result (_Trim (vla-get-promptstring attrib))))
(chr 160)
result
)
)
I get:
((" " . "Mark") (" " . "Male") (" " . "NO.4") (" " . "15"))
^ space
-
The mod was only meant for AIberto as I suspect the character set on his computer is making DOSLIB chuck a wobbly.
But thanks for testing sir! :)
-
The mod was only meant for AIberto as I suspect the character set on his computer is making DOSLIB chuck a wobbly.
But thanks for testing sir! :)
Prego Brav'uomo. :wink:
-
Thanks MP & kb
problem solved ! You're a good guy :smitten:
-
I had heard of the Turkey test a while ago but I ignored it for the most part; when would my code ever be run by anyone in Turkey (which, after reading up on the subject I learned that, isn't the point) and/but no one, besides me, runs my code. ...The above is a good example of the Turkey test and I think I am finally going to take the problem more seriously and start reading up on it again.
Great detective work, MP!
ref: Turkey test (http://www.moserware.com/2008/02/does-your-code-pass-turkey-test.html)
-
Thanks AIberto; John.
FYI, I dumped the notion of using the attribute prompts. As David had mentioned, if there is not perfect synchronization between attribute sequencing and the associated block def the prompting would be out of wack. Worse, if attributes instances are created completely independent of a block def, e.g. AutoCAD Electrical, prompts are not to be realized.
The program in my original post was modified accordingly. It still sorts the attributes from top to bottom, left to right, but displays the tags instead of the prompts, thus should work on any insert with attributes, regardless how the attributes were birthed.
Cheers.