ziele_o2k Posted January 11, 2018 Share 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 Link to comment Share on other sites More sharing options...
Grrr Posted January 12, 2018 Share Posted January 12, 2018 Thats interesting, but where do you use that kind of dimensioning? And would this type be more clear: Quote Link to comment Share on other sites More sharing options...
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.