Block numbering routine - problem with *U blocks

August 23, 2023

Hi.

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

August 23, 2023

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

August 23, 2023

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

August 23, 2023

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
)

August 23, 2023

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

August 23, 2023

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

August 23, 2023

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

August 23, 2023

Fairly sure Lee Mac will have what yuo want somewhere

August 23, 2023

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.

August 23, 2023

@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

August 23, 2023

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

August 23, 2023

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

August 24, 2023

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.

August 24, 2023

@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

August 25, 2023

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.

August 25, 2023

@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

Sign In

Block numbering routine - problem with *U blocks

Recommended Posts

aridzv

j2lstaples

aridzv

Kajanthan

CyberAngel

aridzv

aridzv

Steven P

j2lstaples

aridzv

aridzv

aridzv

j2lstaples

aridzv

BIGAL

aridzv

Join the conversation

Tutorials

Forums

Activity