0 Members and 1 Guest are viewing this topic.
(defun c:Wat ( / _GetAttribData _CollateRecord _CollateRecords _Sort _Pad _Main ) (defun _GetAttribData ( insert ) (mapcar (function (lambda ( a ) (list (vla-get-tagstring a) (vla-get-textstring a)))) (append (vlax-invoke insert 'GetAttributes) (vlax-invoke insert 'GetConstantAttributes) ) ) ) (defun _CollateRecord ( data ) ( (lambda ( tags ) (apply 'append (mapcar (function (lambda ( tag ) (cdr (assoc tag data)))) tags ) ) ) '("MARK" "CONTROL") ) ) (defun _CollateRecords ( records new_record / key group ) (if new_record (if (setq group (assoc (setq key (car new_record)) records)) (subst (append group (cdr new_record)) group records) (cons new_record records) ) records ) ) (defun _Sort ( records ) (vl-sort (mapcar (function (lambda ( g ) (cons (car g) (acad_strlsort (cdr g))))) records ) (function (lambda ( a b ) (< (car a) (car b)))) ) ) (defun _Pad ( text len ) (while (< (strlen text) len) (setq text (strcat text " ")) ) text ) (defun _Main ( / ss i records len ) (if (setq ss (ssget '((0 . "insert") (66 . 1)))) (progn (vl-load-com) (repeat (setq i (sslength ss)) (setq records (_CollateRecords records (_CollateRecord (_GetAttribData (vlax-ename->vla-object (ssname ss (setq i (1- i))) ) ) ) ) ) ) (setq len (+ 4 (apply 'max (mapcar 'strlen (cons "MARK" (mapcar 'car records)))))) (princ (strcat "\n" (_Pad "MARK" len) "CONTROL\n")) (foreach group (_Sort records) (princ (strcat "\n" (_Pad (car group) len) (cadr group))) (foreach item (cddr group) (princ (strcat "\n" (_Pad "" len) item))) (princ "\n") ) ) ) (princ) ) (_Main))