Topic: ascending sorting dynamic blocks ( by diameters and lenght )and rename the block

[serge_c]

Need guru's help . I make a lot of movements arrive at the final result, but i am sure it possible to make the shortest way :
if it's possible to select the blocks and automatically the lisp will sort the block by diameter and lenght and after that  if is possible to imput the number which will begin the renumbering !!!
Thanks in advance !!!

[BIGAL]

Here is an example of sort on 2 items.

Code: [Select]

(setq lst (list '(20 123) '(25 345) '(10 456) '(8 234)))
; sorts on 1st two items
(setq lst (vl-sort lst
'(lambda (a b)
    (cond
      ((< (car a) (car b)))
      ((= (car a) (car b)) (< (cadr a) (cadr b)))
    )
  )
)
)


[serge_c]

BIGAL thanks for this example but I think, I will not succeed by my self.
I make some simple lisp , but this i gonna be to complicated for me , Taht why  I am asking for your level ""GURU's LEVEL""

[HOSNEYALAA]

HI
TEST THIS

Code: [Select]



(vl-load-com)

(defun c:test (/ A11 A2 A3 ACDBBLOCKREFERENCE ATTDATA ATTRIBUTES^ ATTS LST PATTERN SS0)

 
 (if  (and
       (progn (initget 7)  (setq pattern(getint  "\nSpecify input NO : ")))
       (setq ss0 (ssget '((0 . "insert") (66 . 1))))
     )
  (progn
   
   
   (foreach ename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss0)))
;;;      (setq ename (mapcar'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss0))))
    (setq AcDbBlockReference (vlax-ename->vla-object ename))
;;;    (setq attributes^ (vlax-invoke AcDbBlockReference 'GetAttributes))
    (progn
           (setq atts (vlax-invoke AcDbBlockReference 'getattributes))
           (foreach att atts
             (cond
                   ((wcmatch (vla-get-tagstring att) "DIAMETRU")
                    (setq a2 (vla-get-textstring att))
                   )
                   ((wcmatch (vla-get-tagstring att) "Lungimea")
                    (setq a3 (vla-get-textstring att))
                   )
             )
                 
           )
           (setq attdata (cons (list (atof a2) (atof a3) AcDbBlockReference) attdata))
         )
     )
;;;(setq attdata nil)
    ; sorts on 1st two items

   ;;BIGAL
      (setq lst (vl-sort attdata
'(lambda (a b)
    (cond
      ((< (car a) (car b)))
      ((= (car a) (car b)) (< (cadr a) (cadr b)))
    )
  )
)
)



   (foreach ename (mapcar 'caddr lst)
;;;      (setq ename (caDr (mapcar 'caddr lst)))
   
   
    (progn
           (setq atts (setq attributes^ (vlax-invoke ename 'GetAttributes)))
           (foreach att atts
;;;      (setq att (car atts))
     
             (cond ((wcmatch (setq a11(vla-get-tagstring att)) "Pozitia")
                     (vla-put-textstring att (RTOS pattern 2 0 ))
                   )
                   
                   
             )
                 
           )
     
           
         )
     (setq pattern (+ 1 pattern))
     )

   









   
  ); progn
 ); if

 (princ)
);





[HOSNEYALAA]

HH

[serge_c]

Hi HOSNEYALAA !!!
it's work but final result is not like in the example.
the duplicated position should  be deleted.
apreciate your work , can you finish it please ?

[HOSNEYALAA]

What is the required result
After you work soring
If you explain with a picture or a drawing
Because I am not good at English

[serge_c]

I mark how is the result after your lisp , and how it should be

[HOSNEYALAA]

hi
this this

Code: [Select]

 
 ;; HOSNEYALAA 23.10.2020 ;;

(vl-load-com)

(defun c:test (/ A11 A2 A3 ACDBBLOCKREFERENCE ATTDATA ATTRIBUTES^ ATTS LST PATTERN SS0)

 
 (if  (and
       (progn (initget 7)  (setq pattern(getint  "\nSpecify input NO : ")))
       (setq ss0 (ssget '((0 . "insert") (66 . 1))))
     )
  (progn
   
   
   (foreach ename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss0)))
;;;      (setq ename (mapcar'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss0))))
    (setq AcDbBlockReference (vlax-ename->vla-object ename))
;;;    (setq attributes^ (vlax-invoke AcDbBlockReference 'GetAttributes))
    (progn
           (setq atts (vlax-invoke AcDbBlockReference 'getattributes))
           (foreach att atts
             (cond
                   ((wcmatch (vla-get-tagstring att) "DIAMETRU")
                    (setq a2 (vla-get-textstring att))
                   )
                   ((wcmatch (vla-get-tagstring att) "Lungimea")
                    (setq a3 (vla-get-textstring att))
                   )
             )
                 
           )
           (setq attdata (cons (list (atof a2) (atof a3) AcDbBlockReference) attdata))
         )
     )
;;;(setq attdata nil)
    ; sorts on 1st two items

   ;;BIGAL
      (setq lst (vl-sort attdata
'(lambda (a b)
    (cond
      ((< (car a) (car b)))
      ((= (car a) (car b)) (< (cadr a) (cadr b)))
    )
  )
)
)

(setq  a  (car(car lst)) b (cadar lst))

   (foreach ename lst
;;;      (setq ename (cadr lst))
   
   
    (progn
           (setq atts (setq attributes^ (vlax-invoke (caddr ename) 'GetAttributes)))
     
           (foreach att atts
;;;      (setq att (car atts))
     
             ( if     (and (wcmatch (setq a11(vla-get-tagstring att)) "Pozitia") (equal a (setq ach  (car ename))) (equal b (setq bch  (cadr ename))))
     (progn
                             (vla-put-textstring att (RTOS pattern 2 0 ))
  (setq a ach
                                b bch
                                   )
        );;progn
       )

     ( if     (and (wcmatch (setq a11(vla-get-tagstring att)) "Pozitia")
   (or (/= a (setq ach  (car ename))) (/= b (setq bch  (cadr ename))))
   )
     (progn
                             (vla-put-textstring att (RTOS (setq pattern (+ 1 pattern)) 2 0 ))
(setq a ach
                                b bch
                                   )
        );;progn
       )

     

               
         );;;(foreach
     
     );;;; progn

     
  ) ;;;(foreach



      );;;; progn
 ); if

 (princ)
);

















[HOSNEYALAA]

hh

[serge_c]

Hi again  HOSNEYALAA!!!
You aproximaximatelly done it !!!
but some positions still repeating .In the image you will understand.

[serge_c]

your result

[HOSNEYALAA]

HI

TEST THIS

WRONG THIS

Code: [Select]


             ( if     (and (wcmatch (setq a11(vla-get-tagstring att)) "Pozitia") (equal a (setq ach  (car ename))) (equal b (setq bch  (cadr ename))))
     (progn
                             (vla-put-textstring att (RTOS pattern 2 0 ))
  (setq a ach
                                b bch
                                   )
        );;progn
       )


Code: [Select]


 
 ;; HOSNEYALAA 23.10.2020 ;;

(vl-load-com)

(defun c:test (/ A11 A2 A3 ACDBBLOCKREFERENCE ATTDATA ATTRIBUTES^ ATTS LST PATTERN SS0)

 
 (if  (and
       (progn (initget 7)  (setq pattern(getint  "\nSpecify input NO : ")))
       (setq ss0 (ssget '((0 . "insert") (66 . 1))))
     )
  (progn
   
   
   (foreach ename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss0)))
;;;      (setq ename (mapcar'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss0))))
    (setq AcDbBlockReference (vlax-ename->vla-object ename))
;;;    (setq attributes^ (vlax-invoke AcDbBlockReference 'GetAttributes))
    (progn
           (setq atts (vlax-invoke AcDbBlockReference 'getattributes))
           (foreach att atts
             (cond
                   ((wcmatch (vla-get-tagstring att) "DIAMETRU")
                    (setq a2 (vla-get-textstring att))
                   )
                   ((wcmatch (vla-get-tagstring att) "Lungimea")
                    (setq a3 (vla-get-textstring att))
                   )
             )
                 
           )
           (setq attdata (cons (list (rtos (atof a2) 2 0) (rtos (atof a3) 2 0) AcDbBlockReference) attdata))
         )
     )
;;;(setq attdata nil)
    ; sorts on 1st two items

   ;;BIGAL
      (setq lst (vl-sort attdata
'(lambda (a b)
    (cond
      ((< (car a) (car b)))
      ((= (car a) (car b)) (< (cadr a) (cadr b)))
    )
  )
)
)

(setq  a  (car(car lst)) b (cadar lst))

   (foreach ename lst
;;;      (setq ename (nth 10 lst))
   
   
    (progn
           (setq atts (setq attributes^ (vlax-invoke (caddr ename) 'GetAttributes)))
     
           (foreach att atts
;;;      (setq att (car atts))
     
             ( if     (and (wcmatch (setq a11(vla-get-tagstring att)) "Pozitia") (equal a (car ename)) (equal b (cadr ename)))
     (progn
                             (vla-put-textstring att (RTOS pattern 2 0 ))
 
        );;progn
       )

     ( if     (and (wcmatch (setq a11(vla-get-tagstring att)) "Pozitia")
   (or (/= a (car ename) ) (/= b (cadr ename)))
   )
     (progn
                             (vla-put-textstring att (RTOS (setq pattern (+ 1 pattern)) 2 0 ))
     (setq a (car ename))
                             (setq b (cadr ename))
                                   
        );;progn
       )

     

               
         );;;(foreach
     
     );;;; progn

     
  ) ;;;(foreach



      );;;; progn
 ); if

 (princ)
);


















[HOSNEYALAA]

HH

[serge_c]

little modification," please " the lenght are little bit not ascending, must see in the picture , your result