Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 09/05/2022 in all areas

  1. Hi AridZV, havent done much lisping anymore so just to get you started. I leave the table creating to you or somebody else because this has been done a google times on this forum (defun c:aridzv ( / ss l sl) (princ "\nSelect blocks : ") (cond ((not (setq ss (ssget '((0 . "INSERT"))))) (princ "\nComputer says no : nothing selected")) ((not (vl-consp (setq l (process_blocks ss)))) (princ "\nComputers says no : sorry no can do")) (t (setq l (sort_list l)) (create_table l)) ) (princ) ) (defun process_blocks ( %ss / lst order descr ) (foreach bo (SS->OL %ss) (setq order (sav bo "ORDER") descr (sav bo "ITEM_DESCRIPTION")) (if (and order descr) (setq lst (update_list order descr lst))) (setq order nil descr nil) ) lst ) ; description plus example : (update_list order description list) ; (setq lst (list (cons "1" (list "a" 1)) (cons "3" (list "c" 1)))) ; - update counter for order 1 from 1 -> 2 ; (setq lst (update_list "1" "a" lst)) -> (("1" "a" 2) ("3" "c" 1)) ; - add order "2" ; (setq lst (update_list "2" "b" lst)) -> (("1" "a" 2) ("3" "c" 1) ("2" "b" 1)) ; now sort the list ; (sort_list lst) -> (("1" "a" 2) ("2" "b" 1) ("3" "c" 1)) (defun update_list ( o d l / r) (if (not (setq r (assoc o l))) (setq l (append l (list (cons o (list d 1))))) (setq l (subst (cons o (list (cadr r) (1+ (caddr r)))) r l)) ) ) (defun sort_list (l) (vl-sort l (function (lambda (a b) (< (atoi (car a)) (atoi (car b))))))) ; at this point your list is sorted & ready to go (defun create_table (l) (princ "\n\n*** Ask Google how to create a table ***\n\n") (prl l) (textscr) ) ; tiny lisp lib ; show attribute value (defun sav ( blk tag ) (setq tag (strcase tag) blk (ent->vla blk)) (if blk (vl-some '(lambda (x) (if (= tag (strcase (vla-get-tagstring x))) (vla-get-textstring x))) (vlax-invoke blk 'getattributes)))) (defun ent->vla ( e / ss ) (cond ((= (type e) 'VLA-OBJECT) e) ((= (type e) 'ENAME)(vlax-ename->vla-object e)) ((and (= (type e) 'STR) (tblsearch "block" e)(setq ss (ssget "x" (list (cons 0 "INSERT")(cons 2 e))))) (ent->vla (ssname ss 0))) (t nil) ) ) (defun SS->OL (ss / i l)(setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l) (defun prl (lst)(mapcar '(lambda(x)(princ "\n")(princ x)) lst))
    1 point
×
×
  • Create New...