Lisp to increment letters with prefix or suffix

[Steven P]

My Mistake, Edited above

 

[aridzv]

4 hours ago, Steven P said:

My Mistake, Edited above

 

Hi @Steven P.

I did that correction (actually before posting my previos post...)

(LM:vl-setattributevalue ( blk "ORDER" (nth 2 blk) ))

Still getting the error message...

Edited August 21, 2023 by aridzv

[maahee]

Thank sir

Edited August 22, 2023 by maahee

[Steven P]

14 hours ago, aridzv said:

Hi @Steven P.

I did that correction (actually before posting my previos post...)

(LM:vl-setattributevalue ( blk "ORDER" (nth 2 blk) ))

Still getting the error message...

 

 

Spent 10 minutes seeing what I missed - should be this line instead:

 

(LM:vl-setattributevalue bobj "Order" (rtos (nth 2 blk)) )

 

[aridzv]

@Steven P & @BIGAL

WORKS PERFECTLY - MANY THANKS!!!

aridzv

[aridzv]

@Steven P

one more question - 

the lisp set put's the numbers from top right to lower left.

is it possible to change it so it will go from lower left to top right?

 

thanks,

aridzv.

[Steven P]

Without testing I reckon there will be something in his code like vl-sort, look to see if there is an operator like < or > and swap it to the other one. That might work

[aridzv]

well, I celebrated too soon...

the Lisp does not take *U blocks (dynamic blocks) by their block name But by the *U name ,

and it causes lisp to see identical blocks as different and give them a different number - I've attached an example drawing.

dose anyone have an idea how to solve this?

 

thaks,

aridzv.

 

Drawing2.dwg

Edited August 23, 2023 by aridzv
wrong sample file

[BIGAL]

Ok very easy a block can have 2 names, the BLOCK Name and an Effective Name, so for the *u123 block you can get its effective name.

 

(setq obj (vlax-ename->vla-object (car  (entsel "Pick block"))))
(vla-get-name obj)
"*U21"  so its a dynamic block
(vla-get-effectivename obj)

Ok now the problem you have possibly copied from another dwg so understand in the other dwg it should reveal true block name.

 

This is another dwg I looked at can see result.

(setq obj (vlax-ename->vla-object (car  (entsel "Pick block"))))
Pick block#<VLA-OBJECT IAcadBlockReference 0000000061FF4420>
(vla-get-name obj)
"*U308"
(vla-get-effectivename obj)
"TAWINDOW"

Ok so you get the blocks then test does it have a effective name if so get that name.

 

Will look for an example.

(vlax-property-available-p obj "Effectivename")

Returns True if exists.

Edited August 25, 2023 by BIGAL

[aridzv]

@BIGAL

I tried to use your example this way:

1. convert the entity to VLAX object.

2. get the effctive name.

 

here is the relevant code from the point of selecting the blocks and up to the point of assigning the name to a varaible:

(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 (cdr (assoc 2 ent)))
 (setq obj2 (vlax-ename->vla-object ent))
 (setq bname2 (vlax-property-available-p ent "Effectivename"))
 (princ bname2)

 

this is the error I'm getting:

; ----- Error around expression -----
; (AL-ENAME2OBJ ENAME)
; in file : 
; C:\Users\USER\AppData\Roaming\Bricsys\BricsCAD\Lsp\Blocks_Numbering_By_Type4.lsp

 

and here is full code - see how many attempts I did:

(defun c:Blocks_Numbering_By_Type4 ( / ss ent bname lst lst2 x y val val2 pointmin pointmax bobj mp bname2 obj2)
(vl-load-com)
(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 (cdr (assoc 2 ent)))
 (setq obj2 (vlax-ename->vla-object ent))
 (setq bname2 (vlax-property-available-p ent "Effectivename"))
 (princ bname2)
 ;;(setq bname2 (vla-get-effectivename (vlax-ename->vla-object (cdr (assoc - 1 ent)))))
 
 ;;(setq obj2 (vlax-ename->vla-object ent))
;; (setq bname2 (vla-get-effectivename obj2))
 ;;(setq bname2 (getpropertyvalue obj2 "EffectiveName~Native"))

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

 

regards,

aridzv.

[aridzv]

@BIGAL

see the attched final lisp file.

note this:

 (setq obj2 (vlax-ename->vla-object ent_n))
 (setq bname (getpropertyvalue ent_n "EffectiveName~Native"))

 

bricscad.

Blocks_Numbering_By_Type6.lsp

Edited August 25, 2023 by aridzv

[aridzv]

Hi.

after solving the effective name ordeal the lisp works brilliantly.

there is one issue that I'm trying to solve:

the lisp sort the blocks list by their alphabetical order (block-A will get the first number and block-b will get the next).

I'm trying to get the numbering according to the blocks order in the drawing - first selected first number.

I need the numbering from left to right or right to left - just that the nubering will be according to the blocks location in the drawing and not their alphabetical order.

 

I tried to first remove duplicates from the list and then number the blocks according to their location in the list but failed.

 

here is the code I started to write with the duplicates removle function:

(defun c:Blocks_Numbering_By_Type1 ( / ss ent ent_n bname lst lst2 x y val val2 pointmin pointmax bobj mp layname layobj)
(vl-load-com)

  (foreach layname '("BC_SUBTRACT" "Handle" "Wasers_Nuts_Gaskets"); add as many as you like
    (if (setq layobj (tblobjname "layer" layname)); it exists
      (vla-put-LayerOn (vlax-ename->vla-object layobj) 0); then -- turn it Off
    ); if
  ); foreach
  (princ)

;;(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_n (ssname ss (setq x (1- x)))
              ent (entget ent_n)
        );;close setq    

       (setq bname (getpropertyvalue ent_n "EffectiveName~Native"))
       (setq ent (cdr (assoc -1 ent)))
       (setq lst (cons (list bname ent) lst))
      );;close repeat

;;(setq lst (vl-sort lst '(lambda (x y) (< (car x)(car y)))))
(setq lst (remove_dups lst))
(princ lst)
                                            
(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))
      );;close progn
   );;close if
  (setq x (1+ x))
);;close repeat

(foreach blk lst2
  (setq ent (cadr blk))
  (setq bobj (vlax-ename->vla-object ent))
  ;;(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) 2 0) )
);;close foreach
                                             
);;close progn from top
);;close if from top
(princ)

                                                 (foreach layname '("BC_SUBTRACT" "Handle" "Wasers_Nuts_Gaskets"); add as many as you like
    (if (setq layobj (tblobjname "layer" layname)); it exists    
      (vla-put-LayerOn (vlax-ename->vla-object layobj) 1); then -- turn it back on
    ); if
  ); foreach
  (princ)

)



(defun remove_dups  (lst / out)
  (while lst
    (setq out (cons (car lst) out))
    (setq lst (vl-remove (car lst) (cdr lst))))
  (reverse out))


(defun remove_doubles  (lst)
  (if lst
    (cons (car lst) (remove_doubles (vl-remove (car lst) lst)))))

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

 

I also attched a sample drawing here.

thanks,

aridzv.

Drawing2.dwg

Edited August 28, 2023 by aridzv

[maahee]

 Tan, Acos, asin function 

(setq vertpt-1 (polar vertpt-f  (+ (* pi 1.5) (angle p1 p2)) 0.04))

(setq fwpt-3 (polar fwpt  (+ (* pi 0.5) (angle p1 p2)) 0.04))

(setq vertpt-2 (polar vertpt-1 (+ (angle vertpt-f fwpt) (Acos (/ 0.04 (distance vertpt-f fwpt))) ( * pi 1.5)) 0.04))

(setq fwpt-3 (polar fwpt-3 (+ (angle vertpt-f fwpt) (Acos (/ 0.04 (distance vertpt-f fwpt))) ( * pi 0.5)) 0.04))

(command "line" vertpt-1 fwpt-4 fwpt-3 vertpt-2 "c")

Showing error: no function definition: Acos

 

I calculate angle between hypotenuse and adjacent side 90 degree triangle 

Edited September 2, 2023 by maahee

[BIGAL]

To maahee you need to start a new post I think, not add to this one. Admin will fix. Also more information "Not working" is not enough.

[maahee]

8 hours ago, BIGAL said:

To maahee you need to start a new post I think, not add to this one. Admin will fix. Also more information "Not working" is not enough.

Ok sir thanks for guiding me

Edited September 2, 2023 by maahee