Code Red > AutoLISP (Vanilla / Visual)
ascending sorting dynamic blocks ( by diameters and lenght )and rename the block
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: ---
;; 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)
);
--- End code ---
HOSNEYALAA:
hh
Navigation
[0] Message Index
[#] Next page
[*] Previous page
Go to full version