0 Members and 1 Guest are viewing this topic.
(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))) ) )))
(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 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) );
( 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 )
;; 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));