Message 1 of 4
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi all,
I discovered this routine (below) that was created in 2017 for a very similar reason we need it for in our office.
However, it doesn't seem to work with our plant naming / numbering format, it seems.
I have attached a real example of a DWG containing various multileaders with various plant types and plant yield numbers that I would love for it to work as the author wrote it for the other person.
A Gif from the author is also attached showing the routine working for better clarity.
;;Ranjit Singh
;;7/10/17
(defun c:somefunc (/ colwid dat lst numcols numrows rowht) (setq lst (mapcar '(lambda (x) (cons (cdadr x) (cdar x))) (mapcar '(lambda (x) (cdr (vl-remove-if-not '(lambda (x) (= 302 (car x))) (entget x)))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "MULTILEADER")))))))) dat (acad_strlsort (unique (mapcar 'car lst))) numrows (+ 1 (length dat)) numcols 2 rowht (* 0.12 (getvar 'cannoscalevalue)) colwid 1) (tblfill (vla-addtable (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point (cdr (cons (initget 7) (getpoint "\nSelect Table Insertion point: ")))) (+ 1 numrows) numcols rowht colwid) (cons (cons "PLANT ID" dat) (list (cons "PLANT COUNT" (mapcar '(lambda (x) (count x lst)) dat))))) (princ)) (defun tblfill (tblobj data / ind tab) (setq tab -1) (mapcar '(lambda (x) (setq ind 1 tab (1+ tab)) (mapcar '(lambda (x) (vla-setcellvaluefromtext tblobj ind tab x 0) (setq ind (1+ ind))) x)) data)) (defun unique (x) (unique2 x ())) (defun unique2 (x y) (cond ((null x) y) (t (unique2 (vl-remove (car x) x) (cons (car x) y))))) (defun count (x y) (rtos (apply '+ (mapcar 'read (mapcar 'cdr (vl-remove-if-not '(lambda (z) (= x (car z))) y)))) 2 0))
Solved! Go to Solution.