Block numbering routine - problem with *U blocks

[aridzv]

Hi.

following this topic,

I got help with a lisp that number blocks by their type (see attached lisp "Blocks_Numbering_By_Type.lsp").

the problem is that the lisp see *U blocks by the *U code and not by the block name (Effective name?),

And give each of them their own number - see attached sample drawing.

 

I thought about making the following change but I don't know how and I'm not sure if it will help:

;;change this line:
(setq ss (ssget '((0 . "INSERT"))))

;;to this line?:
(list(cons 0  "INSERT")(cons 2 (strcat "`*U*,"blName)))

 

Any help will be appreciated,

aridzv.

Blocks_Numbering_By_Type.lsp

Drawing2.dwg

Edited August 23, 2023 by aridzv

[j2lstaples]

;; I think you need to change this part:
(setq bname (cdr (assoc 2 ent)))

To this part:
(setq bname (LM:al-effectivename (ssname ss x))


You have to add LM:al-effectivename function at the end

 

You are using dynamic blocks and they're using different values in (cdr (assoc 2 ent).

 

Edit: ent is actually entity information not the entity name so I revised the change to be (ssname ss x) and not ent.

Edited August 23, 2023 by j2lstaples

[aridzv]

55 minutes ago, j2lstaples said:

;; I think you need to change this part:
(setq bname (cdr (assoc 2 ent)))

To this part:
(setq bname (LM:al-effectivename (ssname ss x))


You have to add LM:al-effectivename function at the end

 

You are using dynamic blocks and they're using different values in (cdr (assoc 2 ent).

 

Edit: ent is actually entity information not the entity name so I revised the change to be (ssname ss x) and not ent.

Hi @j2lstaples and thanks for your reply.

1. LM:al-effectivename expect to get a block object as a varaible and not a list as far as I understand.

2. never the less I tried your code and getting an error:

; ----- Error around expression -----
; (LM:AL-EFFECTIVENAME ENT)

I also tried to use it like this (pass an object) but getting the same error:

 (setq ent (entget (ssname ss (setq x (1- x)))))
 (setq bname (LM:al-effectivename ent))

 

thanks,

aridzv.

Edited August 23, 2023 by aridzv

[Kajanthan]

24 minutes ago, aridzv said:

Hi @j2lstaples and thanks for your reply.

1. LM:al-effectivename expect to get a block object as a varaible and not a list as far as I understand.

2. never the less I tried your code and getting an error:

; ----- Error around expression -----
; (LM:AL-EFFECTIVENAME ENT)

I also tried to use it like this (pass an object) but getting the same error:

 (setq ent (entget (ssname ss (setq x (1- x)))))
 (setq bname (LM:al-effectivename ent))

 

thanks,

aridzv.

You must add this function end of that file..

 

 (defun LM:al-effectivename ( ent / blk rep )
    (if (wcmatch (setq blk (cdr (assoc 2 (entget ent)))) "`**")
        (if
            (and
                (setq rep
                    (cdadr
                        (assoc -3
                            (entget
                                (cdr
                                    (assoc 330
                                        (entget
                                            (tblobjname "block" blk)
                                        )
                                    )
                                )
                               '("AcDbBlockRepBTag")
                            )
                        )
                    )
                )
                (setq rep (handent (cdr (assoc 1005 rep))))
            )
            (setq blk (cdr (assoc 2 (entget rep))))
        )
    )
    blk
)

 

[CyberAngel]

Any block with a name that starts with *U is an anonymous block. I don't think you can rename them.

[aridzv]

1 hour ago, Kajanthan said:

You must add this function end of that file..

 

 (defun LM:al-effectivename ( ent / blk rep )
    (if (wcmatch (setq blk (cdr (assoc 2 (entget ent)))) "`**")
        (if
            (and
                (setq rep
                    (cdadr
                        (assoc -3
                            (entget
                                (cdr
                                    (assoc 330
                                        (entget
                                            (tblobjname "block" blk)
                                        )
                                    )
                                )
                               '("AcDbBlockRepBTag")
                            )
                        )
                    )
                )
                (setq rep (handent (cdr (assoc 1005 rep))))
            )
            (setq blk (cdr (assoc 2 (entget rep))))
        )
    )
    blk
)

 

 

Hi @Kajanthan,

at first I used this LM function:

(defun LM:effectivename ( obj )
    (vlax-get-property obj
        (if (vlax-property-available-p obj 'effectivename)
            'effectivename
            'name
        )
    )
)

 

but changed it to what you wrote - still getting error...

[aridzv]

1 hour ago, CyberAngel said:

Any block with a name that starts with *U is an anonymous block. I don't think you can rename them.

hi @CyberAngel.

I'm not trying to chane the block name,

but trying to set one of its attributes value.

Edited August 23, 2023 by aridzv

[Steven P]

Fairly sure Lee Mac will have what yuo want somewhere

[j2lstaples]

4 hours ago, aridzv said:

hi @CyberAngel.

I'm not trying to chane the block name,

but trying to set one of its attributes value.

 

I said to use this:

(setq bname (LM:al-effectivename (ssname ss x))

and use what @Kajanthan posted.

 

LM:al-effectivename requires an entityname not a vla-object.

[aridzv]

@j2lstaples

thanks for the reply.

 

I Did waht you wrote,

see the code below.

it dos'nt raise an error this time but the resault is the same.

see the (princ bname) I add - it gives the names and they are still *u type:

Select entities: GASKET 4In PN16_3d*U21*U22GASKET 4In PN16_3d

 

here is the code I uesed:

(defun c:Blocks_Numbering_By_Type3 ( / ss ent bname lst lst2 x y val val2 pointmin pointmax bobj mp)
(setvar 'textstyle "standard")
(prompt "select blocks")
(setq ss (ssget '((0 . "INSERT"))))

(if (= ss nil)
(alert "No blocks selected ")
(progn
(setq lst '())
(repeat (setq x (sslength ss))
 (setq ent (entget (ssname ss (setq x (1- x)))))
 (setq bname (LM:al-effectivename (ssname ss x))) ;;(setq bname (cdr (assoc 2 ent)))
 (princ bname)
 (setq ent (cdr (assoc -1 ent))) 
 (setq lst (cons (list bname ent) lst))
)
(setq lst (vl-sort lst '(lambda (x y) (< (car x)(car y)))))
                                             
(setq lst2 '())
(setq x 0 y 1)
(repeat (length lst)
(if (= (car (nth x lst)) (car (nth (1+ x) lst)))
  (setq lst2 (cons (list (car (nth x lst)) (cadr (nth x lst)) y) lst2))
  (progn 
  (setq lst2 (cons (list (car (nth x lst))(cadr (nth x lst)) y) lst2))
  (setq y (1+ y))
  )
)
(setq x (1+ x))
)
  
(foreach blk lst2
;;(princ blk)
  (setq ent (cadr blk))
  ;;(princ ent)
  (setq bobj (vlax-ename->vla-object ent))
  ;;(princ bobj)
  ;;(vla-GetBoundingBox bobj 'minpoint 'maxpoint)
  ;;(setq pointmin (vlax-safearray->list minpoint))
  ;;(setq pointmax (vlax-safearray->list maxpoint))
  ;;(setq mp (mapcar '* (mapcar '+ pointmin pointmax) '(0.5 0.5)))
  ;;(command "text" mp 1.0 0.0 (nth 2 blk))
  (LM:vl-setattributevalue bobj "ORDER" (rtos (nth 2 blk)) )
)
                                             
)
)
(princ)


)

 (defun LM:al-effectivename ( ent / blk rep )
    (if (wcmatch (setq blk (cdr (assoc 2 (entget ent)))) "`**")
        (if
            (and
                (setq rep
                    (cdadr
                        (assoc -3
                            (entget
                                (cdr
                                    (assoc 330
                                        (entget
                                            (tblobjname "block" blk)
                                        )
                                    )
                                )
                               '("AcDbBlockRepBTag")
                            )
                        )
                    )
                )
                (setq rep (handent (cdr (assoc 1005 rep))))
            )
            (setq blk (cdr (assoc 2 (entget rep))))
        )
    )
    blk
)

(defun LM:vl-setattributevalue ( blk tag val )
    (setq tag (strcase tag))
    (vl-some
       '(lambda ( att )
            (if (= tag (strcase (vla-get-tagstring att)))
                (progn (vla-put-textstring att val) val)
            )
        )
        (vlax-invoke blk 'getattributes)
    )
)

 

thanks,

aridzv.

Edited August 23, 2023 by aridzv

[aridzv]

@j2lstaples

see the lisp below.

the first part is a selection set of blocks by condtions.

if the selection from the user is:

1. Specify block name <any>: any

2. Specify attribute tag <any>: ORDER

3. Specify attribute value: any

it create a list of all blocks with the attribute tag "ORDER" and by name.

 

maybe there is a way to use this?

;; Block Selection  -  Lee Mac
;; Selects all blocks in the current layout with a given block name or which contain a specified attribute tag and/or value.

(defun c:bsel ( / att atx blk cnt ent enx flg idx sel str tag )
    (setq blk (strcase (getstring t  "\nSpecify block name <any>: "))
          tag (strcase (getstring "\nSpecify attribute tag <any>: "))
          str (strcase (getstring t (strcat "\nSpecify attribute value" (if (= "" tag blk) ": " " <any>: "))))
    )
    (if (not (= "" str tag blk))
        (if
            (and
                (setq sel
                    (ssget
                        (append
                           '((000 . "INSERT"))
                            (if (not (= "" tag str)) '((066 . 1)))
                            (if (/= "" blk) (list (cons 2 (strcat "`*U*," blk))))
                            (if (= 1 (getvar 'cvport))
                                (list (cons 410 (getvar 'ctab)))
                               '((410 . "Model"))
                            )
                        )
                    )
                )
                (progn
                    (repeat (setq idx (sslength sel))
                        (setq ent (ssname sel (setq idx (1- idx)))
                              enx (entget ent)
                        )
                        (cond
                            (   (not (or (= "" blk) (wcmatch (strcase (LM:name->effectivename (cdr (assoc 2 enx)))) blk)))
                                (ssdel ent sel)
                            )
                            (   (member (cdr (assoc 66 enx)) '(nil 0)))
                            (   (progn
                                    (setq att (entnext ent)
                                          atx (entget  att)
                                          flg nil
                                    )
                                    (while
                                        (and (= "ATTRIB" (cdr (assoc 0 atx)))
                                            (not
                                                (and
                                                    (or (= "" str) (wcmatch (strcase (cdr (assoc 1 atx))) str))
                                                    (or (= "" tag) (wcmatch (strcase (cdr (assoc 2 atx))) tag))
                                                )
                                            )
                                        )
                                        (setq att (entnext att)
                                              atx (entget  att)
                                        )
                                    )
                                    (= "SEQEND" (cdr (assoc 0 atx)))
                                )
                                (ssdel ent sel)
                            )
                        )
                    )
                    (< 0 (setq cnt (sslength sel)))
                )
            )
            (progn
                (princ (strcat "\n" (itoa cnt) " block" (if (= 1 cnt) "" "s") " found."))
                (sssetfirst nil sel)
            )
            (princ "\nNo blocks found.")
        )
    )
    (princ)
)

;; Block Name -> Effective Block Name  -  Lee Mac
;; blk - [str] Block name

(defun LM:name->effectivename ( blk / rep )
    (if
        (and (wcmatch blk "`**")
            (setq rep
                (cdadr
                    (assoc -3
                        (entget
                            (cdr (assoc 330 (entget (tblobjname "block" blk))))
                           '("acdbblockrepbtag")
                        )
                    )
                )
            )
            (setq rep (handent (cdr (assoc 1005 rep))))
        )
        (cdr (assoc 2 (entget rep)))
        blk
    )
)

(princ)

 

thanks,

aridzv.

[aridzv]

Hi @Steven P

3 hours ago, Steven P said:

Fairly sure Lee Mac will have what yuo want somewhere

 

I looked but didn't find any...

Thanks,

aridzv

[j2lstaples]

16 hours ago, aridzv said:

@j2lstaples

see the lisp below.

the first part is a selection set of blocks by condtions.

if the selection from the user is:

1. Specify block name <any>: any

2. Specify attribute tag <any>: ORDER

3. Specify attribute value: any

it create a list of all blocks with the attribute tag "ORDER" and by name.

 

maybe there is a way to use this?

;; Block Selection  -  Lee Mac
;; Selects all blocks in the current layout with a given block name or which contain a specified attribute tag and/or value.

(defun c:bsel ( / att atx blk cnt ent enx flg idx sel str tag )
    (setq blk (strcase (getstring t  "\nSpecify block name <any>: "))
          tag (strcase (getstring "\nSpecify attribute tag <any>: "))
          str (strcase (getstring t (strcat "\nSpecify attribute value" (if (= "" tag blk) ": " " <any>: "))))
    )
    (if (not (= "" str tag blk))
        (if
            (and
                (setq sel
                    (ssget
                        (append
                           '((000 . "INSERT"))
                            (if (not (= "" tag str)) '((066 . 1)))
                            (if (/= "" blk) (list (cons 2 (strcat "`*U*," blk))))
                            (if (= 1 (getvar 'cvport))
                                (list (cons 410 (getvar 'ctab)))
                               '((410 . "Model"))
                            )
                        )
                    )
                )
                (progn
                    (repeat (setq idx (sslength sel))
                        (setq ent (ssname sel (setq idx (1- idx)))
                              enx (entget ent)
                        )
                        (cond
                            (   (not (or (= "" blk) (wcmatch (strcase (LM:name->effectivename (cdr (assoc 2 enx)))) blk)))
                                (ssdel ent sel)
                            )
                            (   (member (cdr (assoc 66 enx)) '(nil 0)))
                            (   (progn
                                    (setq att (entnext ent)
                                          atx (entget  att)
                                          flg nil
                                    )
                                    (while
                                        (and (= "ATTRIB" (cdr (assoc 0 atx)))
                                            (not
                                                (and
                                                    (or (= "" str) (wcmatch (strcase (cdr (assoc 1 atx))) str))
                                                    (or (= "" tag) (wcmatch (strcase (cdr (assoc 2 atx))) tag))
                                                )
                                            )
                                        )
                                        (setq att (entnext att)
                                              atx (entget  att)
                                        )
                                    )
                                    (= "SEQEND" (cdr (assoc 0 atx)))
                                )
                                (ssdel ent sel)
                            )
                        )
                    )
                    (< 0 (setq cnt (sslength sel)))
                )
            )
            (progn
                (princ (strcat "\n" (itoa cnt) " block" (if (= 1 cnt) "" "s") " found."))
                (sssetfirst nil sel)
            )
            (princ "\nNo blocks found.")
        )
    )
    (princ)
)

;; Block Name -> Effective Block Name  -  Lee Mac
;; blk - [str] Block name

(defun LM:name->effectivename ( blk / rep )
    (if
        (and (wcmatch blk "`**")
            (setq rep
                (cdadr
                    (assoc -3
                        (entget
                            (cdr (assoc 330 (entget (tblobjname "block" blk))))
                           '("acdbblockrepbtag")
                        )
                    )
                )
            )
            (setq rep (handent (cdr (assoc 1005 rep))))
        )
        (cdr (assoc 2 (entget rep)))
        blk
    )
)

(princ)

 

thanks,

aridzv.

 

 

 

Ah, if you want the Attribute called ITEM_DESCRIPTION, you can use:

;********************************************************;
;; Get Attribute Value  -  Lee Mac
;; Returns the value held by the specified tag within the supplied block, if present.
;; blk - [ent] Block (Insert) Entity Name
;; tag - [str] Attribute TagString
;; Returns: [str] Attribute value, else nil if tag is not found.
(defun LM:getattributevalue (blk tag / val enx) 
  (while 
    (and 
      (null val)
      (setq blk (entnext blk))
      (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk)))))
    )
    (if (= (strcase tag) (strcase (cdr (assoc 2 enx)))) 
      (setq val (cdr (assoc 1 (reverse enx))))
    )
  )
)

 

It would be called by using:

(setq bname (LM:getattributevalue (ssname ss x) "ITEM_DESCRIPTION"))

 

 

But in this case for the *U21 block, I'll just rename that block to the proper name which is the ITEM_DESCRIPTION attribute or filter unnamed *U blocks to give the attribute value instead. I would use something like this:

 

(if (vl-string-search "*U" bname)
	(setq bname (LM:getattributevalue (ssname ss x) "ITEM_DESCRIPTION"))
    (setq bname bname)
)

Also, whenever you print the names, I would get an endline delimiter to see all the names properly or delimit with a spacebar even or commas.

For me though, I would probably design an ssget filter that takes a list of names of blocks to get all that I need but that's a bit overkill but I already have that somewhere.

[aridzv]

@j2lstaples

Thanks!!

The approach of give the attribute "ITEM_DESCRIPTION" value as the *U block name instead Looks promising.

 

where to put this code in my lisp?

(if (vl-string-search "*U" bname)
	(setq bname (LM:getattributevalue (ssname ss x) "ITEM_DESCRIPTION"))
    (setq bname bname)
)

 

thanks,

aridzv.

*DEIT:

my "ITEM_DESCRIPTION"  attribute contain spaces and some times special characters,

so it might not work...

Edited August 24, 2023 by aridzv

[BIGAL]

This is like part 2 of your other post about "*Uxxx" blocks it is much better to not have multiple posts about the same theme.

yes can do block name, attribute tag name, read your other post.

[aridzv]

@Kajanthan

@j2lstaples

@BIGAL

 

first,

I must apologize for the goose chase I created.

The reason why the code you posted didn't work was that I use bricscad, and bricscad required a slightly different code.

I finally got it right,

see the relevant lines needed in bricscad to get the effective name:

(setq ss (ssget '((0 . "INSERT"))))

(if (= ss nil)
(alert "No blocks selected ")
(progn
(setq lst '())
      (repeat (setq x (sslength ss))
        (setq ent_n (ssname ss (setq x (1- x)))
              ent (entget ent_n)
        )    
       
 (setq bname (cdr (assoc 2 ent)))
 (setq obj2 (vlax-ename->vla-object ent_n))
 (setq bname (getpropertyvalue ent_n "EffectiveName~Native"))

 

and I attached the full lisp file here as well.

aridzv.

Blocks_Numbering_By_Type6.lsp

Edited August 25, 2023 by aridzv