;; str2lst by Gilles Chanteau ;
;; Transforme un chaine avec séparateur en liste de chaines ;
;; Modified to remove Leading and Trailing spaces ;
;; Arguments ;
;; str : la chaine à transformer en liste ;
;; sep : le séparateur ;
;; ;
;; Exemples ;
;; (str2lst "a b c" " ") -> ("a" "b" "c") ;
;; (str2lst "1,2,3" ",") -> ("1" "2" "3") ;
;; (mapcar 'read (str2lst "1,2,3" ",")) -> (1 2 3) ;
(defun str2lst
(str sep
/ pos
) )
)
)
;; getblkename by ymg ;
;; ;
;; Original Code by Tim Wiley ;
;; Argument: Block Name ;
;; Returns: list of enames Block in Drawing ;
(defun getblkename
(blkname
/ blkl
) 'effectivename
'name
)
)
blkname
)
)
(setq blkl
(cons (vlax
-vla
-object
->ename obj
) blkl
)) )
)
blkl
)
;; Count Items - Lee Mac ;
;; Returns a list of dotted pairs detailing the number of ;
;; occurrences of each item in a supplied list. ;
(defun countitems
( l
/ c x
) )
)
)
)
;;; strtoclipboard ;
;;; Not too sure of the origin of that one maybe ASMI ;
(defun strtoclipboard
(str
/ html
) 'ClipBoardData
)
'setData "Text" str
)
)
)
(if (or (and (> i
0) (< s e
)) (and (< i
0) (> s e
))) (cons s
(in_range
(+ i s
) e i
)) )
)
;;****************************************************************************;
;; mktable by ymg ;
;; ;
;; Argument: title Title for table ;
;; headerl A list of header for column of Table ;
;; list list of list containing the data ;
;; ;
;; Returns: Will create a table on the current layer and will return, ;
;; the object table. ;
;; ;
;; For those who wonders ** is a dummy variable. ;
;; ;
;;****************************************************************************;
(defun mktable
(title headerl lst th
/ ** mspace pt tbl nrow ncol row col vc
) pt
(vlax
-make
-safearray vlax-vbDouble '
(0 .
2)) tbl (vla-addtable mspace pt nrow ncol (* 2 th) (* 25 th))
** (vla-setcelltextheight tbl 0 0 th)
** (vla-settext tbl 0 0 title)
)
(vla-setcelltextheight tbl row col th)
(vla-setcellalignment tbl row col acTopCenter)
(vla-settext tbl row col val)
)
(vla-setcellalignment tbl row (- col 1) acTopLeft)
)
tbl
)
;; sd by ymg ;
;; Creates a COUNT list and a table detailing how many occurences ;
;; of FASE attributes for each TIT attributes. ;
;; COUNT list is also transferred to the Window Clipboard, ;
;; ready to be pasted. ;
(defun c:sd
( / attl bl cb colwl count en enl lf n sep tbl tit txth
)
;; bl is a list of ename for Block SteelDim" ;
(setq bl
(getblkename
"SteelDim")) )
)
)
)
)
;; attl is a list of list '((TIT FASE)... ) ;
;; Now we count each occurrence of a given pair ;
(setq count
(countitems attl
))
;; Re-format attl to be a list of list ((TIT QTY FASE)...) ;
)
;; Sort on FASE then on TIT ;
)
;; Creates The COUNT Table ;
tbl (mktable "COUNT" '("TIT" "QTY" "FASE") attl txth)
colwl
(list (* txth
10) (* txth
5) (* 15 txth
)) )
; Adjust Column Width of the Table. ;
(vla
-setcolumnwidth tbl
(setq n
(1+ n
)) col
) )
; Put the whole COUNT list in Variable cb and Send to Clipboard ;
lf "\n"
cb
(strcat "COUNT" lf
"TIT" sep
"QTY" sep
"FASE") )
)
)
(strtoclipboard cb)
;; Initiated Move of the table and awaits destination point ;
(command "_MOVE" (vlax
-vla
-object
->ename tbl
) "" (getvar 'viewctr
) pause
)
)
(princ "\nSteel Dim.....Start with SD")