Code Red > AutoLISP (Vanilla / Visual)

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

<< < (4/4)

HOSNEYALAA:
hi
test


--- Code: ---

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

















--- End code ---

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

HOSNEYALAA:
You're welcome anytime.

Navigation

[0] Message Index

[*] Previous page