Leaderboard
Popular Content
Showing content with the highest reputation on 09/02/2022 in all areas
-
Got to love end of week team meetings, try this: This should copy the selected texts to the clipboard, paste into excel the usual way, paste, ctr+V, whatever, each selected text is on a new line in excel. (defun SetClipBoardText ( MyText / htmlfile result ) (vlax-invoke (vlax-get (vlax-get (setq htmlfile (vlax-create-object "htmlfile")) 'ParentWindow) 'ClipBoardData) 'setData "Text" Mytext) (vlax-release-object htmlfile) (princ) ) (defun C:ST (/ txt ss typ) (if (eq (setq txt (strcase (getstring "\nSearch for Text [Area]: "))) "");hit enter for defult options. (setq txt "AREA") ;set defult search options here ) (if (setq ss (ssget "_X" (list '(0 . "MTEXT,TEXT,MULTILEADER,DIMENSION") (cons 410 (getvar 'ctab))))) (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (setq typ (cdr (assoc 0 (entget ent)))) (cond ((member typ '("TEXT" "MTEXT" "MULTILEADER")) (setq obj (vlax-ename->vla-object ent)) ;convert to val-object (if (vl-string-search txt (strcase (vlax-get obj 'TextString))) (progn) ;if found leave in selection set (ssdel ent ss) ;if not found in string remove from selection s ) ) ((eq typ "DIMENSION") (setq obj (vlax-ename->vla-object ent)) ;convert to val-object (if (vl-string-search txt (strcase (vlax-get obj 'TextOverride))) (progn) ;if found leave in selection set (ssdel ent ss) ;if not found in string remove from selection s ) ) ) ) ) (if (> (sslength ss) 1) ;if anything is still in the selection set (progn (prompt (strcat "\n" (itoa (sslength ss)) " Entitys containing \"" txt "\"")) (sssetfirst nil ss) ) (prompt (strcat "\n" txt "Not Found in Drawing")) ) (setq Selectedtexts nil) (setq acount 0) (while ( < acount (sslength ss)) (if (= nil Selectedtexts) (setq Selectedtexts (cdr (assoc 1 (entget (ssname ss acount))))) (setq Selectedtexts (strcat Selectedtexts (chr 10) (cdr (assoc 1 (entget (ssname ss acount)))))) ) (setq acount (+ acount 1)) ) ; end while (SetClipBoardText Selectedtexts) (princ Selectedtexts) (princ) )1 point
-
Adding this at the end oh MHUPPS code above will create a string with all the texts ...... (prompt (strcat "\n" txt "Not Found in Drawing")) ) ;;;;NEW PART HERE;;;;; (setq Selectedtexts nil) (setq acount 0) (while ( < acount (sslength ss)) (if (= nil Selectedtexts) (setq Selectedtexts (cdr (assoc 1 (entget (ssname ss acount))))) (setq Selectedtexts (strcat Selectedtexts ", " (cdr (assoc 1 (entget (ssname ss acount)))))) ) (setq acount (+ acount 1)) ) ; end while (princ Selectedtexts) ;;;CONTINUE WITH OLD LISP HERE;;;;; (princ) ) I have a line above (setq Selectedtexts (strcat Selectedtexts ", " (cdr (assoc 1 (entget (ssname ss acount)))))) which separates the text strings with a comma, you can change this to whatever you want. The above is to show how you can collate the text strings you searched for. If it was me I would either use LISP and AutoCAD to create the report you want (always better I think to avoid one companies software trying to use and talk to another), or to save the output as a CSV file and import that into Excel to filter and count as you want. If you want to keep it simple there is a line I can add to copy this to clipboard. Recently there was another post about writing directly to Excel, BigAl I think had a solution if you want to do that, he might be along later with words of wisdom, or you can look through recent threads and find it out, have a go and see what you can do. See if this works for you and what you want to do from here.1 point
-
1 point
-
As a start, MHUPPs answer here yesterday is a good starting point, selecting all text containing your text string. I reckon it can be changed easily enough to copy the texts to clipboard and so you can paste the texts to excel1 point
-
See if this is what you are looking for. wcmatch and vl-string-search function are both case sensitive so you have to convert ever thing to upper or lower case so they match. unless you want to find the exact text. also might want to add a t to get string if you want to add spaces (getstring T "\nSearch for Text [Area]: ") ;;----------------------------------------------------------------------------;; ;; Searches drawing for Text (defun C:ST (/ txt ss typ) (if (eq (setq txt (strcase (getstring "\nSearch for Text [Area]: "))) "");hit enter for defult options. (setq txt "AREA") ;set defult search options here ) (if (setq ss (ssget "_X" (list '(0 . "MTEXT,TEXT,MULTILEADER,DIMENSION") (cons 410 (getvar 'ctab))))) (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (setq typ (cdr (assoc 0 (entget ent)))) (cond ((member typ '("TEXT" "MTEXT" "MULTILEADER")) (setq obj (vlax-ename->vla-object ent)) ;convert to val-object (if (vl-string-search txt (strcase (vlax-get obj 'TextString))) (progn) ;if found leave in selection set (ssdel ent ss) ;if not found in string remove from selection s ) ) ((eq typ "DIMENSION") (setq obj (vlax-ename->vla-object ent)) ;convert to val-object (if (vl-string-search txt (strcase (vlax-get obj 'TextOverride))) (progn) ;if found leave in selection set (ssdel ent ss) ;if not found in string remove from selection s ) ) ) ) ) (if (> (sslength ss) 1) ;if anything is still in the selection set (progn (prompt (strcat "\n" (itoa (sslength ss)) " Entitys containing \"" txt "\"")) (sssetfirst nil ss) ) (prompt (strcat "\n" txt "Not Found in Drawing")) ) (princ) )1 point
-
@BIGAL Basically have the same code for offset so F for fillets O for offsets. Couldn't get your code to work (must be doing something wrong or BricsCAD) or my code either but matches the same outputs. --edit prob don't need the split string function. ; Enter the filet radius as part of a command line entry f100, O234 for offset, c123.45 for circle, P123 for pline width ; original code and methology by Alan H ; assistance and code that worked by Lee-Mac ; OCT 2015 ((lambda nil (vl-load-com) (foreach obj (cdar (vlr-reactors :vlr-command-reactor)) (if (= "fillet-reactor" (vlr-data obj)) (vlr-remove obj) ) ) (vlr-command-reactor "fillet-reactor" '((:vlr-unknowncommand . fillet-reactor-callback))) ) ) (defun plwid (/ oldwidth) (setq oldwidth (getvar 'plinewid)) (setvar 'plinewid num) (vla-sendcommand fillet-reactor-acdoc "_.pline ") (setvar 'plinewid oldwidth) ) (defun filletrad () (setvar 'filletrad num) (vla-sendcommand fillet-reactor-acdoc "_.fillet ") ) (defun makecirc () (setvar 'circlerad num) (vla-sendcommand fillet-reactor-acdoc "_.Circle ") ) (defun offdist () (setvar 'offsetdist num) (vla-sendcommand fillet-reactor-acdoc "_.Offset ") ) (defun fillet-reactor-callback (obj com / num) (setq com (car com)) (cond ((and (eq (strcase (substr com 1 1)) "F") (numberp (setq num (distof (substr com 2)))) (<= 0.0 num) ) ; and (filletrad) ) ((and (eq (strcase (substr com 1 1)) "C") (numberp (setq num (distof (substr com 2)))) (<= 0.0 num) ) ;and (makecirc) ) ((and (eq (strcase (substr com 1 1)) "O") (numberp (setq num (distof (substr com 2)))) (<= 0.0 num) ) ; and (offdist) ) ((and (eq (strcase (substr com 1 1)) "P") (numberp (setq num (distof (substr com 2)))) (<= 0.0 num) ) ; and (plwid) ) ) ; master cond ) ; defun (or fillet-reactor-acdoc (setq fillet-reactor-acdoc (vla-get-activedocument (vlax-get-acad-object))) )1 point