Topic: attribute edit

[deerailed77]

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

[ChrisCarlson]

Literally have no idea what you are asking

[deerailed77]

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. 

[deerailed77]

heres an example of the attribute

[ronjonp]

Maybe you could sort them by insertion point & Y values.

[Lee Mac]

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.

[MP]

Code: [Select]

(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)

)

[AIberto]

Code: [Select]

(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

[MP]

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:

Code: [Select]

(dos_proplist "Title" "Description" '(("Prompt" . "Value")))
>> (("Prompt" . "Changed_Value"))  [good]

Code: [Select]

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

[MP]

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:

Code: [Select]

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

[David Bethel]

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

[roy_043]

Strange structure:

Code - Auto/Visual Lisp: [Select]

1. (foreach lst (mapcar 'list result data)
2.   ...
3. )

Why not?:

Code - Auto/Visual Lisp: [Select]

1. (mapcar
2.   '(lambda (a b)
3.     ...
4.   )
5.   result
6.   data
7. )

[MP]

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

[AIberto]

Hi MP

If "prompt" is empty , that still will be error :

Code: [Select]

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.

[MP]

Can you post a sample drawing? The program works on the sample dwgs I have that sport attributed blocks with promptless attdefs. Thanks.