TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: serge_c on October 20, 2020, 08:44:33 AM

Title: ascending sorting dynamic blocks ( by diameters and lenght )and rename the block
Post by: serge_c on October 20, 2020, 08:44:33 AM

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

Title: Re: ascending sorting dynamic blocks ( by diameters and lenght )and rename the block
Post by: BIGAL on October 20, 2020, 06:29:30 PM

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


Title: Re: ascending sorting dynamic blocks ( by diameters and lenght )and rename the block
Post by: serge_c on October 21, 2020, 01:13:32 AM

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

Title: Re: ascending sorting dynamic blocks ( by diameters and lenght )and rename the block
Post by: HOSNEYALAA on October 22, 2020, 04:28:48 PM

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





Title: Re: ascending sorting dynamic blocks ( by diameters and lenght )and rename the block
Post by: HOSNEYALAA on October 22, 2020, 04:30:41 PM

HH

Title: Re: ascending sorting dynamic blocks ( by diameters and lenght )and rename the block
Post by: serge_c on October 23, 2020, 03:10:36 AM

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 ?

Title: Re: ascending sorting dynamic blocks ( by diameters and lenght )and rename the block
Post by: HOSNEYALAA on October 23, 2020, 03:44:20 AM

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

Title: Re: ascending sorting dynamic blocks ( by diameters and lenght )and rename the block
Post by: serge_c on October 23, 2020, 04:43:02 AM

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

Title: Re: ascending sorting dynamic blocks ( by diameters and lenght )and rename the block
Post by: HOSNEYALAA on October 23, 2020, 12:09:24 PM

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

















Title: Re: ascending sorting dynamic blocks ( by diameters and lenght )and rename the block
Post by: HOSNEYALAA on October 23, 2020, 12:10:50 PM

hh

Title: Re: ascending sorting dynamic blocks ( by diameters and lenght )and rename the block
Post by: serge_c on October 26, 2020, 01:59:48 AM

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

Title: Re: ascending sorting dynamic blocks ( by diameters and lenght )and rename the block
Post by: serge_c on October 26, 2020, 02:00:43 AM

your result

Title: Re: ascending sorting dynamic blocks ( by diameters and lenght )and rename the block
Post by: HOSNEYALAA on October 26, 2020, 08:40:58 AM

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


















Title: Re: ascending sorting dynamic blocks ( by diameters and lenght )and rename the block
Post by: HOSNEYALAA on October 26, 2020, 08:45:16 AM

HH

Title: Re: ascending sorting dynamic blocks ( by diameters and lenght )and rename the block
Post by: serge_c on October 26, 2020, 09:13:40 AM

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

Title: Re: ascending sorting dynamic blocks ( by diameters and lenght )and rename the block
Post by: HOSNEYALAA on October 26, 2020, 12:00:45 PM

hi
test

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


















Title: Re: ascending sorting dynamic blocks ( by diameters and lenght )and rename the block
Post by: serge_c on October 26, 2020, 12:19:45 PM

SUPER !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Thank you very much HOSNEYALAA !!!!!
you are the best !!!

Title: Re: ascending sorting dynamic blocks ( by diameters and lenght )and rename the block
Post by: HOSNEYALAA on October 26, 2020, 03:04:20 PM

You're welcome anytime.