[编程交流] some changes in pl:wrdcount li

(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      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

(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! ***|;

// 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";        }}}