some changes in pl:wrdcount lisp

[spin]

hello

i 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.

[rkmcswain]

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?

[spin]

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 . "<OR") (0 . "TEXT") (0 . "MTEXT") (-4 . "OR>")))
  _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 . "<OR") (0 . "TEXT") (0 . "MTEXT") (-4 . "OR>")) _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
      LST  nil
) ;_ 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

[spin]

...

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 strcat
STR
   ) ;_ 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.lsp
PL_WrdCount_dia :dialog { //DIALOG
label = "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";
	}
}
}