ziele_o2k Posted January 11, 2018 Posted January 11, 2018 Maybe someone will think this is useful tool - just check gif. https://media.giphy.com/media/l0HU8OGO0xSIui0lq/giphy.gif ;; ============================================== ;; ;; ;; ;; @@@@@ @ @@@@ @ @@@@ @@@ @@ @ @ ;; ;; @ @ @ @ @ @ @ @ @ @ @ ;; ;; @ @ @@@@ @ @@@@ @ @ @ @@ ;; ;; @ @ @ @ @ @ @ @ @ @ ;; ;; @@@@@ @ @@@@ @@@@ @@@@ @@@ @@@ @@@@ @ @ ;; ;; ;; ;; ============================================== ;; ;; 22:50 2018-01-11 © ziele_o2k ;; ;; ============================================== ;; ;; some code copied from Lee Mac's Block Counter ;; ;; http://www.lee-mac.com/blockcounter.html ;; ;; ============================================== ;; (defun c:detsum ( / pz:sub _pt _ss _enx _k _v _res _tab _row _hgt _wth _tg1 _tg2 _tg3) (defun pz:sub ( @key @val @lst / _itm ) (if (setq _itm (assoc @key @lst)) (subst (cons @key (+ @val (cdr _itm))) _itm @lst) (cons (cons @key @val) @lst) ) ) (if (and (setq _ss (ssget '((0 . "DIM*")))) (setq _pt (cd:USR_GetPoint "\nTable insertion point: " 1 nil)) ) (progn (foreach %1 (cd:SSX_Convert _ss 0) (setq _enx (entget %1) _k (cdr(assoc 1 _enx)) _v (cdr(assoc 42 _enx)) _res (pz:sub _k _v _res) ) ) (setq _res (vl-sort (mapcar '(lambda (%) (list (car %) (cd:CON_Real2Str (cdr %) 2 1)) ) _res ) '(eval (list 'lambda '( a b ) (list '< '(strcase (car a)) '(strcase (car b))))) ) ) (setq _hgt (vla-gettextheight (vla-item (vla-item (vla-get-dictionaries (cd:ACX_ADoc)) "acad_tablestyle") (getvar 'ctablestyle) ) acdatarow ) _tg1 "Detail sum" _tg2 "Detail name" _tg3 "Sum" ) (setq _tab (cd:ACX_AddTable (cd:ACX_ASpace) _pt (+ (length _res) 2) 2 (* 2 _hgt) (* _hgt (max (apply 'max (mapcar 'strlen (append (list _tg2) (list _tg3) (apply 'append _res) ) ) ) (/ (strlen _tg1) 2) ) ) ) ) (vla-setText _tab 0 0 _tg1) (vla-setText _tab 1 0 _tg2) (vla-setText _tab 1 1 _tg3) (setq _row 2) (foreach %1 _res (vla-setText _tab _row 0 (car %1)) (vla-setText _tab _row 1 (cadr %1)) (setq _row (1+ _row)) ) ) ) (princ) ) ;; ================================================================== ;; ;; ================================================================== ;; ;; ================================================================== ;; ;; ================================================================== ;; ;; Subfunctions form CADPL-Pack-v1.lsp http://forum.cad.pl ;; ;; ================================================================== ;; ;; ================================================================== ;; ;; ================================================================== ;; ;; ================================================================== ;; ; =========================================================================================== ; ; Pobiera punkt od uzytkownika / Gets point from user ; ; Msg [sTR] - komunikat do wyswietlenia / message to display ; ; Bit [iNT/nil] - bit sterujacy (patrz initget) / control bit (see initget) ; ; Pt [list/nil] - punkt bazowy / base point ; ; ------------------------------------------------------------------------------------------- ; ; (cd:USR_GetPoint "\nWskaz punkt: " 1 nil) ; ; (cd:USR_GetPoint "\nWskaz drugi punkt: " 32 '(5 10 0)) ; ; =========================================================================================== ; (defun cd:USR_GetPoint (Msg Bit Pt / res) (if Bit (initget Bit)) (if (listp (setq res (vl-catch-all-apply (quote getpoint) (if Pt (list Pt Msg) (list Msg) ) ) ) ) res ) ) ; =========================================================================================== ; ; Zmienia PICKSET na liste obiektow / Convert PICKSET to list of objects ; ; Ss [PICKSET] - zbior wskazan / selection sets ; ; Mode [iNT] - typ zwracanych obiektow / type of returned objects ; ; 0 = ENAME, 1 = VLA-OBJECT, 2 = SAFEARRAY ; ; ------------------------------------------------------------------------------------------- ; ; (cd:SSX_Convert (ssget) 1) ; ; =========================================================================================== ; (defun cd:SSX_Convert (Ss Mode / n res) (if (and (member Mode (list 0 1 2)) (not (minusp (setq n (if Ss (1- (sslength Ss)) -1) ) ) ) ) (progn (while (>= n 0) (setq res (cons (if (zerop Mode) (ssname Ss n) (vlax-ename->vla-object (ssname Ss n)) ) res ) n (1- n) ) ) (if (= Mode 2) (vlax-safearray-fill (vlax-make-safearray 9 (cons 0 (1- (length res))) ) res ) res ) ) ) ) ; =========================================================================================== ; ; Konwertuje liczbe na lancuch tekstowy / Converts number to a string ; ; Val [REAL/INT] - liczba do konwersji / conversion number ; ; Unit [iNT/nil] - jednostki wyjsciowe / output unit ; ; nil = domyslne / default | (getvar "LUNITS") ; ; 1 = naukowe / scientific ; ; 2 = dziesietne / decimal ; ; 3 = inzynierskie / engineering ; ; 4 = architektoniczne / architectural ; ; 5 = ulamkowe / fractional ; ; Prec [iNT/nil] - INT = liczba miejsc po przecinku / number of decimal places ; ; nil = domyslna / default | (getvar "LUPREC") ; ; ------------------------------------------------------------------------------------------- ; ; (cd:CON_Real2Str 12 2 4) ; ; =========================================================================================== ; (defun cd:CON_Real2Str (Val Unit Prec / DMZ res) (setq DMZ (getvar "DIMZIN")) (setvar "DIMZIN" (if (not (member (getvar "LUNITS") (list 4 5))) (logand DMZ (~ ) 0 ) ) (setq res (rtos Val (if (and Unit (member Unit (list 1 2 3 4 5))) Unit (getvar "LUNITS") ) (if Prec Prec (getvar "LUPREC")) ) ) (setvar "DIMZIN" DMZ) res ) ; =========================================================================================== ; ; Aktywny dokument / Active document ; ; =========================================================================================== ; (defun cd:ACX_ADoc () (or *cd-ActiveDocument* (setq *cd-ActiveDocument* (vla-get-ActiveDocument (vlax-get-acad-object)) ) ) *cd-ActiveDocument* ) ; =========================================================================================== ; ; Aktywny obszar / Active space ; ; =========================================================================================== ; (defun cd:ACX_ASpace () (if (= (getvar "CVPORT") 1) (vla-item (cd:ACX_Blocks) "*Paper_Space") (cd:ACX_Model) ) ) ; =========================================================================================== ; ; Kolekcja Blocks / Blocks collection ; ; =========================================================================================== ; (defun cd:ACX_Blocks () (or *cd-Blocks* (setq *cd-Blocks* (vla-get-blocks (cd:ACX_ADoc))) ) *cd-Blocks* ) ; =========================================================================================== ; ; Tworzy obiekt typu ACAD_TABLE / Creates a ACAD_TABLE object ; ; Space [VLA-Object] - kolekcja / collection | Model/Paper + Block Object ; ; Pb [list] - punkt bazowy tabeli / table base point ; ; Rows [iNT] - liczba wierszy / number of rows ; ; Cols [iNT] - liczba kolumn / number of columns ; ; RowH [iNT] - wysokosc wierszy / rows height ; ; ColH [iNT] - szerokosc kolumn / columns height ; ; ------------------------------------------------------------------------------------------- ; ; (cd:ACX_AddTable (cd:ACX_ASpace) (getpoint) 5 5 10 30) ; ; =========================================================================================== ; (defun cd:ACX_AddTable (Space Pb Rows Cols RowH ColH) (vla-AddTable Space (vlax-3d-point (trans Pb 1 0)) Rows Cols RowH ColH ) ) Quote
Grrr Posted January 12, 2018 Posted January 12, 2018 Thats interesting, but where do you use that kind of dimensioning? And would this type be more clear: Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.