some changes in pl:wrdcount li
helloi found on this forum a lisp that count text. it's called PL:wrdcount (posted by VVA user, sorry but i can't use links, and lisp is too long to paste it here) and it's works fine, but i would like to use it as a routine in script pro. lisp is with dcl box, and i don't know how to change lisp file, so it save the output file with the count list on specified layer without a dcl box. can anybody help me with this ?
thanks in advance. Without the code (or a link to it), it's going to be near impossible to help you. Have you tried contacting the author of the code also? ok so i divide the code in few posts
pl:wrdcount.lsp:
(defun C:PL:WrdCount (/ SEL _DIAFILE_DIALOG _CASE _FMODE LST _FNAME _LEN _LAYERLST _DATLST _LAYOUTLST _LON _LAN _TMP ) (setq SEL (ssget '((-4 . "")))_CASE "1"_FMODE "f_quoted"_FNAME "" ) ;_ end of setq (if SEL(setq _DATLST (_PL:WCDDatGen SEL _CASE)) ;_ SEL _LEN LST(setq _LAYERLST (cons "*All Layers*" (acad_strlsort (PL:GetLayersList t))) _LAYOUTLST (cons "*All Layouts*" (cons "*Model*" (acad_strlsort (layoutlist))) ) ;_ end of cons) ;_ end of setq ) ;_ end of if (if (setq _DIAFILE (load_dialog "PL_WrdCount.DCL"))(if (setq _DIALOG (new_dialog "PL_WrdCount_dia" _DIAFILE)) (progn (if SEL (progn (mode_tile "layer_lst" 1) (mode_tile "layout_lst" 1) (setq _FNAME (_PL:CCDFileName t nil nil)) ) ;_ end of progn (progn (_PL:CCDSetLayLay _LAYERLST _LAYOUTLST) (set_tile "layer_lst" (itoa (vl-position (setq _LAN (getvar "CLAYER")) _LAYERLST)) ) ;_ end of set_tile (if (= "Model" (setq _LON (vla-get-name (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object) ) ;_ end of vla-get-activedocument ) ;_ end of vla-get-activelayout ) ;_ end of vla-get-name ) ;_ end of setq ) ;_ end of = (setq _LON "*Model*") ) ;_ end of if (set_tile "layout_lst" (itoa (vl-position _LON _LAYOUTLST)) ) ;_ end of set_tile (_PL:CCDiaLstGen (caddr (setq _DATLST (_PL:WCDDatGen (_PL:WCDSel _LON _LAN) _CASE) ) ;_ end of setq ) ;_ end of caddr ) ;_ end of _PL:CCDiaLstGen (setq _FNAME (_PL:CCDFileName nil _LON _LAN)) ) ;_ end of progn ) ;_ end of if (_PL:CCDiaTogOnOff "0" _FNAME) (_PL:CCDiaLstGen (caddr _DATLST)) (set_tile "f_quoted" "1") (set_tile "file_name" _FNAME) (set_tile "case_yes" _CASE) (_PL:CCDInfoText (cadr _DATLST)) (action_tile "write_file" "(_PL:CCDiaTogOnOff $value _FNAME)") (action_tile "file_mode" "(setq _FMODE $value)") (action_tile "layout_lst" "(_PL:CCDiaLstGen (caddr (setq _DATLST (_PL:WCDDatGen (_PL:WCDSel (setq _LON (nth (atoi $value) _LAYOUTLST)) _LAN) _CASE))))(_PL:CCDInfoText (cadr _DATLST))(setq _FNAME (_PL:CCDFileName nil _LON _LAN))(set_tile \"file_name\" _FNAME)" ) ;_ end of action_tile (action_tile "layer_lst" "(_PL:CCDiaLstGen (caddr (setq _DATLST (_PL:WCDDatGen (_PL:WCDSel _LON (setq _LAN (nth (atoi $value) _LAYERLST))) _CASE))))(_PL:CCDInfoText (cadr _DATLST))(setq _FNAME (_PL:CCDFileName nil _LON _LAN))(set_tile \"file_name\" _FNAME)" ) ;_ end of action_tile (action_tile "file_name" "(_PL:CCDiaTogOnOff \"1\" (setq _FNAME $value))" ) ;_ end of action_tile (action_tile "case_yes" "(_PL:CCDiaLstGen (setq LST (_PL:CCPreLstGen (car _DATLST) (setq _CASE $value))))" ) ;_ end of action_tile (action_tile "write" "(_PL:CCFileWrite _FNAME (caddr _DATLST) _FMODE)") (start_dialog) (unload_dialog _DIAFILE) ) ;_ end of progn (alert "Can't open dialog!")) ;_ end of if(alert "Can't load dialog!") ) ;_ end of if (princ)) ;_ end of defun(defun _PL:CCDFileName (_SEL _LAYOUT _LAYER / _PATH) (setq _PATH (strcat (getvar "DWGPREFIX") (vl-string-right-trim ".dwg" (getvar "DWGNAME")) ) ;_ end of strcat ) ;_ end of setq (if (not _SEL)(progn (if (/= _LAYOUT "*All Layouts*") (setq _PATH (strcat _PATH (if (= _LAYOUT "*Model*") "-Model" (strcat "-" _LAYOUT) ) ;_ end of if ) ;_ end of strcat ) ;_ end of setq ) ;_ end of if (if (/= _LAYER "*All Layers*") (setq _PATH (strcat _PATH (strcat "-" _LAYER))) ) ;_ end of if) ;_ end of progn ) ;_ end of if (strcat _PATH ".res")) ;_ end of defun(defun _PL:WCDSel (LON LAN / _TMP) (if (/= LON "*All Layouts*")(setq _TMP (list (if (= LON "*Model*") '(410 . "Model") (cons 410 LON) ) ;_ end of if ) ;_ end of list) ;_ end of setq ) ;_ end of if (if (/= LAN "*All Layers*")(setq _TMP (cons (cons 8 LAN) _TMP)) ) ;_ end of if (ssget "_X" (append '((-4 . "")) _TMP))) ;_ end of defun(defun _PL:CCDSetLayLay (_LAYERLST _LAYOUTLST) (start_list "layer_lst") (mapcar 'add_list _LAYERLST) (end_list) (start_list "layout_lst") (mapcar 'add_list _LAYOUTLST) (end_list)) ;_ end of defun(defun PL:GetLayersList (_T / _L) (if (setq _L (cdr (assoc 2 (tblnext "layer" _T))))(cons _L (PL:GetLayersList NIL)) ) ;_ end of if) ;_ end of defun(defun _PL:WCDDatGen (SEL _CASE / _LEN LST) (if SEL(setq SEL(PL:Pickset->List SEL 0) _LEN (length SEL) SEL(acad_strlsort (apply 'append (mapcar '_PL:String->List (mapcar 'PL:StrExtractor SEL)) ) ;_ end of apply ) ;_ end of acad_strlsort LST(_PL:CCPreLstGen SEL _CASE)) ;_ end of setq(setq _LEN nil LSTnil) ;_ end of setq ) ;_ end of if (list SEL _LEN LST)) ;_ end of defun(defun _PL:CCDInfoText (_LEN) (set_tile "info_txt" (if _LEN (strcat (itoa _LEN) " text " (if (= _LEN 1) "entity" "entities" ) ;_ end of if " selected" ) ;_ end of strcat "Nothing selected" ) ;_ end of if ) ;_ end of set_tile) ;_ end of defun(defun _PL:CCFileWrite (NAME LST MODE / _FOPEN) (setq NAME (PL:String-Rep (PL:String-Rep NAME "\\" "/") "//" "/")) (if (setq _FOPEN (open NAME "r"))(progn (alert (strcat "File: \"" NAME "\" already exist!\nPlease enter new filename.") ) ;_ end of alert (close _FOPEN)) ;_ end of progn(if (setq _FOPEN (open NAME "w")) (progn (write-line (substr (apply 'strcat (cond ((= MODE "f_comma") (mapcar (function (lambda (_X) (strcat "\n" (car _X) ";" (itoa (cadr _X))) ) ;_ end of lambda ) ;_ end of function LST ) ;_ end of mapcar ) ((= MODE "f_plain") (mapcar (function (lambda (_X) (strcat "\n" (car _X) " - " (itoa (cadr _X))) ) ;_ end of lambda ) ;_ end of function LST ) ;_ end of mapcar ) ((= MODE "f_tab") (mapcar (function (lambda (_X) (strcat "\n" (car _X) "\t" (itoa (cadr _X))) ) ;_ end of lambda ) ;_ end of function LST ) ;_ end of mapcar ) (t (mapcar (function (lambda (_X) (strcat "\n\"" (car _X) "\" - " (itoa (cadr _X)) ) ;_ end of strcat ) ;_ end of lambda ) ;_ end of function LST ) ;_ end of mapcar ) ) ;_ end of cond ) ;_ end of apply 2 ) ;_ end of substr _FOPEN ) ;_ end of write-line (close _FOPEN) (alert (strcat "Result wrote to file: \"" NAME "\"")) ) ;_ end of progn (alert (strcat "Can't write to file: \"" NAME "\""))) ;_ end of if ) ;_ end of if) ;_ end of defun(defun _PL:CCPreLstGen (LST CASE) (if (not (= CASE "1"))(setq LST (mapcar 'strcase LST)) ) ;_ end of if (PL:LstGroup LST)) ;_ end of defun(defun _PL:CCDiaLstGen (LST) (start_list "chr_list") (mapcar 'add_list (mapcar (function (lambda (_X) (strcat "\"" (car _X) "\"\t.....\t" (itoa (cadr _X))) ) ;_ end of lambda ) ;_ end of function LST ) ;_ end of mapcar ) ;_ end of mapcar (end_list)) ;_ end of defun(defun _PL:CCDiaTogOnOff (TOG FNAM) (if (= (atoi TOG) 0)(progn (mode_tile "file_name" 1) (mode_tile "f_comma" 1) (mode_tile "f_plain" 1) (mode_tile "f_quoted" 1) (mode_tile "f_tab" 1) (mode_tile "write" 1)) ;_ end of progn(progn (mode_tile "file_name" 0) (mode_tile "f_comma" 0) (mode_tile "f_plain" 0) (mode_tile "f_quoted" 0) (mode_tile "f_tab" 0) (if (= FNAM "") (mode_tile "write" 1) (mode_tile "write" 0) ) ;_ end of if) ;_ end of progn ) ;_ end of if) ;_ end of defun(defun PL:Pickset->List (SEL I / _TMP) (if (setq _TMP (ssname SEL I))(cons _TMP (PL:Pickset->List SEL (1+ I))) ) ;_ end of if) ;_ end of defun(defun _PL:String->List (_STR) (vl-remove-if 'not (subst nil "" (PL:String->List _STR " ")))) ;_ end of defun(defun PL:String->List (_STR _BR / _POS) (if (setq _POS (vl-string-search _BR _STR))(cons (substr _STR 1 _POS) (PL:String->List (substr _STR (+ (strlen _BR) _POS 1) ) ;_ end of substr _BR ) ;_ end of PL:String->List) ;_ end of cons(cons _STR '()) ) ;_ end of if) ;_ end of defun(defun PL:StrExtractor (ENT / _TMP) (if (vlax-property-available-p (setq _TMP (vlax-ename->vla-object ENT)) 'textstring) ;_ end of vlax-property-available-p(if (= (vla-get-objectname _TMP) "AcDbMText") (vl-string-subst "" "}" (PL:MTxtStrClr (PL:String-Rep (PL:String-Rep (PL:String-Rep (PL:String-Rep (vla-get-textstring _TMP) "\\\\" "") "\\{" "(" ) ;_ end of PL:String-Rep "\\}" ")" ) ;_ end of PL:String-Rep "\\P" " " ) ;_ end of PL:String-Rep ) ;_ end of PL:MTxtStrClr ) ;_ end of vl-string-subst (vla-get-textstring _TMP)) ;_ end of if ) ;_ end of if) ;_ end of defun ...
pl:wrdcount.lsp:
(defun PL:MTxtStrClr (STR / _POS) (if (setq _POS (PL:StrMSrch STR '("{\\" "\\f" "\\F")))(strcat (if (> _POS 0) (substr STR 1 _POS) "" ) ;_ end of if (PL:MTxtStrClr (substr STR (+ 2 (vl-string-search ";" STR (1+ _POS)))))) ;_ end of strcatSTR ) ;_ end of if) ;_ end of defun(defun PL:StrMSrch (STR LST / _TMP) (car (vl-sort (vl-remove-if 'not (mapcar (function (lambda (_X _Y) (vl-string-search _Y _X) ) ;_ end of lambda ) ;_ end of function (repeat (length LST) (setq _TMP (cons STR _TMP))) LST ) ;_ end of mapcar ) ;_ end of vl-remove-if '< ) ;_ end of vl-sort ) ;_ end of car) ;_ end of defun(defun PL:LstGroup (_LST / _FIRST) (if _LST(cons (list (setq _FIRST (car _LST)) (length (vl-remove-if-not 'not (subst nil _FIRST _LST))) ) ;_ end of list (PL:LstGroup (vl-remove _FIRST _LST))) ;_ end of cons ) ;_ end of if) ;_ end of defun(defun PL:String-Rep (_STR _OLD _NEW / _POS) (if (setq _POS (vl-string-search _OLD _STR))(strcat (substr _STR 1 _POS) _NEW (PL:String-Rep (substr _STR (+ (strlen _OLD) _POS 1) ) ;_ end of substr _OLD _NEW ) ;_ end of PL:String-Rep) ;_ end of strcat_STR ) ;_ end of if) ;_ end of defun(defun PL:EchoLoad () (princ "\nType: \"PL:WrdCount\" in the command string for begining.") (princ)) ;_ end of defun(PL:EchoLoad);|«Visual LISP© Format Options»(90 4 70 2 T "end of " 90 9 1 0 0 T T nil T);*** DO NOT add text below the comment! ***|;
pl:wrdcount.dcl:
// Dialog box for WrdCount.lspPL_WrdCount_dia :dialog { //DIALOGlabel = "PL Char Counter";:boxed_column { label = "File Full Name:"; :edit_box { key = "file_name"; } :spacer {}}:boxed_column { label = "Layer/Layout Selector"; :row { :popup_list { key = "layer_lst"; } :popup_list { key = "layout_lst"; } } :spacer {}}:row { :list_box { key = "chr_list"; fixed_width = true; width = 30; tabs = "20 23"; is_tab_stop = false; } :column { alignment = right; :boxed_column { label = "Write to File"; :toggle { key = "write_file"; label = "Write"; } :boxed_row { label = "File Type"; :radio_column { key = "file_mode"; :radio_button { key = "f_comma"; label = "Comma"; } :radio_button { key = "f_plain"; label = "Plain text"; } :radio_button { key = "f_tab"; label = "Tabulated"; } :radio_button { key = "f_quoted"; label = "Quoted"; } } } } :boxed_column { label = "Case Sensitive"; :toggle { key = "case_yes"; label = "Yes"; } } :spacer {} :row { :button { fixed_width = true; width = 11; key = "write"; label = "&Write"; } :button { fixed_width = true; width = 11; is_default = true; is_cancel = true; key = "close"; label = "&Close"; } } :spacer {} }}:boxed_column { label = "Info"; :text { alignment = centered; is_bold = true; key = "info_txt"; }}}
页:
[1]