; lxx_find = dbx不打开目录文件替换字符(支持多重块).-----by lxx.2007.4 测试ok!
; v1.0 支持选目录和手选多图,支持块中块内文字;
; v1.1 支持多项文字替换.
; v1.4 支持本图替换操作.自动regen.
; v1.3 优化本图替换速度
; v1.4 支持块属性.
; v1.5 支持旧字符含通配特殊字符,进行转义(加`). 支持修改锁定图层内实体.
(defun c:lxx_find ( / old_cmd cname fil fname fpath vcol ff i fns nstr ostr pathfile pathkey nstrs ostrs
                      xo-infdo evaldo evalcur x$sub x$subs
                  )
; xo-infdo fname vcol func) = dbx技术对文件内集合进行操作
; 参数: fname = cad文件(*.dwg格式)
      ; vcol = 集合列表.如'(modelspace paperspace)
      ; func = 操作函数名, 如: 'xx 或 '(lambda(x)....)
             ; 操作函数必须含一个变量(集合内实体). 如: (defun xx (x) ...)
; 返回: 分别操作的表(表内容根据函数来定义).
; 说明: vcol可以是如下集合:
; All Collection Objects(所有的集合实体:)
; Blocks   Dictionaries  DimStyles  funccuments  FileDependencies  Groups
; Hyperlinks  Layers  Linetypes  MenuBar  MenuGroups  ModelSpace  
; PaperSpace  PlotConfigurations  PopupMenu  PopupMenus  
; RegisteredApplications  SelectionSets  TextStyles  Toolbar
; Toolbars  UCSs  Viewports  Views
(defun xo-infdo (fname vcol func / doc cname ret verkey doc e ent i regkey ss ssblk atts blks cdoc cnames docs llays)
  (setq fname (strcase fname))
  (print fname)
  (setq cdoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq cname (strcat (getvar "DWGPREFIX") (getvar "DWGNAME"))) ;; 当前文件名.
  (vlax-for x (vlax-get (vlax-get-acad-object) 'documents) (setq docs (cons x docs)))
  (setq cnames (mapcar '(lambda(x)(strcase (strcat (vla-get-path x) "\\" (vla-get-name x)))) docs))
  (if (member fname cnames)
    (progn
      ;; v1.5加入,锁定图层解锁.>>可放入为xo-infdo的参数.后补>>
      (evaldo cdoc (vla-get-layers cdoc)
       '(lambda(x) (if (= :vlax-true (vla-get-lock x))
                       (progn (setq llays (cons x llays))
                              (vla-put-lock x :vlax-false)
                       )
                    )
        )
      )
      (evalcur (setq doc (nth (- (length docs) (length (member fname cnames))) docs)));处理当前文件,evalcur函数
      (mapcar '(lambda(x) (vla-put-lock x :vlax-true)) llays)
    )
    ;; 处理非当前文件.
    (progn
      (setq verkey  (if (> (atoi (getvar "AcadVer")) 15) ".16" "")
            *DBXDOC (vla-getinterfaceobject (vlax-get-acad-object) (strcat "ObjectDBX.AxDbDocument" verkey))
      )
      (vla-open *dbxdoc fname :vlax-false)      ;open
      ;; v1.5加入,锁定图层解锁.>>可放入为xo-infdo的参数.后补>>
      (evaldo *dbxdoc (vla-get-layers *dbxdoc)
            '(lambda(x) (if (= :vlax-true (vla-get-lock x))
                            (progn (setq llays (cons x llays))
                                   (vla-put-lock x :vlax-false)
                            )
                        )
             )
      )
      ;;
      (setq ret (mapcar '(lambda (x) (evaldo *dbxdoc (vlax-get *dbxdoc x) func)) vcol))
      ;(vlax-dump-object *dbxdoc T)
      ;; v1.5加入,锁定图层解锁恢复>>
      (mapcar '(lambda(x) (vla-put-lock x :vlax-true)) llays)
      ;;
      (vlax-invoke *dbxdoc 'saveas fname)
      (vlax-release-object *dbxdoc)
    )
  )
  ret
)
;;; 处理非打开文件.
  (defun evaldo (doc obj func)
    (vlax-map-collection obj
      '(lambda (x)
           (cond ((vlax-property-available-p x 'count)
		          (evaldo doc x func)
		         )
                 ((vlax-method-applicable-p x 'GetAttributes)
                  (mapcar '(lambda (y) ((eval func) y)) (vlax-invoke x 'GetAttributes))
				 )
                 ((eval func) x)
            )
       )
    )
  )
;;;*当前文件* ;(setq doc cdoc) ;(setq cnames nil)
  (defun evalcur (doc / atts blks e ent i regkey ss ssblk x y)
    
    (princ (if (equal doc cdoc) "(*当前文件*)" "(*已打开文件*)"))
    ;;激活已打开文件..->>>>>bug, vlisp先天缺陷? 不能跨文档
    (vla-Activate doc)
    ;;处理*text
    (if (setq i 0
              ss (ssget "x" (list (cons 0 "*TEXT") (cons 1 fil)))
        )
        (while (setq e (ssname ss i))
               (setq i (1+ i) ent (entget e))
               (entmod (subst (cons 1 (x$subs nstrs ostrs (cdr (assoc 1 ent))))
                              (assoc 1 ent)
                               ent
                       )
               )
       )
    )
    (princ "\n .......文字处理完毕.")
    ;;处理 块内文字.
    (if (setq blks (vla-get-blocks doc))
        (vlax-for x blks         ;(vla-item (vla-get-blocks doc) 1)
           (setq regkey nil)
           (vlax-for y x
              (if (and (wcmatch (vla-get-objectname y) "AcDb*Text")
                       (wcmatch (vla-get-textstring y) fil)
                  )
                  (progn (vla-put-textstring y (x$subs nstrs ostrs (vla-get-textstring y)))
                         (setq regkey T)
                  )
              )
           )
           (if (and regkey (< 0 (vla-get-count x)))
               (if (setq i 0
                         ssblk (ssget "x" (list (cons 0 "INSERT") (cons 2 (vla-get-name x))))
                   )
                   (while (setq e (ssname ssblk i))
                          (setq i (1+ i))
                          (entupd e)
                   )
               )
          )
      )
    )
    (princ "\n .......块内文字处理完毕.")
    ;;处理块属性.
    (if (setq i 0
              ss (ssget "x" (list (cons 0 "INSERT") (cons 66 1)))
        )
        (while (setq e (ssname ss i))
               (setq i (1+ i) atts (vlax-invoke (vlax-ename->vla-object e) 'getattributes))
               (mapcar '(lambda (x / y)
                          (if (wcmatch (setq y (vla-get-textstring x)) fil)
                              (vla-put-textstring x (x$subs nstrs ostrs y))
                           )
                        )
                        atts
                )
       )
    )
    (princ "\n .......块属性处理完毕.")
    (vla-Activate cdoc) ;;恢复激活原当前文件.
    doc
  )

  ; (x$sub 新$ 旧$ 字符串) = 字符串替换-------------------------------lxx.2004.2
; (x$sub " " "-" "32-33-0.01-哈哈") -> "32 33 0.01 哈哈"
(defun x$sub (n$ o$ str / n)
  (setq n 0)
  (while (setq n (vl-string-search o$ str n))
   (setq str (vl-string-subst n$ o$ str n) n (+ n (strlen n$)))
  )
  str
)

; (x$subs 新$表 旧$表 字符串) = 字符串多项替换--lxx.2007.4
; 功能:替换字符串中符合替换表的多项字符.
; 测试: (x$subs '("aa" "1") '("bb" "2") "bbc-bb2132") ->"aac-aa1131" 
(defun x$subs (nstrs ostrs str)
  (mapcar '(lambda (x y) (setq str (x$sub x y str))) nstrs ostrs)
  str
)


  (mini_start nil)
  (princ "\n lxx_find = dbx不打开目录文件替换字符(支持多重块)v1.5-----by lxx.2007.4")
  (initget "1 2 3")
  (setq pathkey (getkword "\n 1-选目录/2-多选文件/3-本图操作<3>:"))
  (or pathkey (setq pathkey "3"))
  (setq vcol '(modelspace paperspace blocks)
        cname (strcat (getvar "DWGPREFIX") (getvar "DWGNAME"))
  )
  (cond
    ((= pathkey "3") (setq fns (list cname)))
    ((= pathkey "2")
     (setq fns (mai_get_files (cond (*dir) ("c:\\")) "cad文件|*.dwg;*.dxf|所有类型|*.*"))
     (if fns (setq *dir (strcat (vl-filename-directory (car fns)) "\\")))
    )
    (T
	 (setq fpath (mai_dos_getdir "选择要处理的文件所在目录" ""));取目录函数.
     (if fpath
         (setq fpath (strcat fpath "\\")
               pathfile (vl-directory-files fpath "*.dwg")
               fns (mapcar '(lambda (x) (strcat fpath x)) pathfile)
         )
     )
    )
  )
  ;;两种方式均支持. 函数 or lambda
  (while (/= "" (setq ostr (getstring "\n 旧字符/<下一步>:")))
     (setq nstr (getstring "\n 新字符<\"\">:") ;>> 待增强,可点取图上文字,sendkey到输入栏,可二次编辑.!!!!!
           ostrs (cons ostr ostrs)
           nstrs (cons nstr nstrs)
     )
  ) ; ostrs,nstrs = 字符列表.一一对应.
  (or (and fns ostrs nstrs) (exit))
  (setq ff  '("#" "," "[" "]" "@" "*" "?" "~" ) ;避免字符和字符过滤符混淆造成错误.
        fil (apply 'strcat
               (mapcar '(lambda (x / strs `)
                          (setq strs (vl-string->list x)
						        ` (ascii "`")
                                x (vl-list->string (apply 'append (mapcar '(lambda(y) (if (member (chr y) ff) (list ` y) (list y))) strs)))
						  )
                          (strcat "*" x "*,")
						)
			            ostrs
			   )
            )
      )
      (princ "\n 正在处理文件:")
      (mapcar '(lambda (fname)
	             (xo-infdo fname vcol
	               '(lambda (x)
                       (if (and (vlax-property-available-p x 'textstring)
                                (wcmatch (setq str (vla-get-textstring x)) fil)
                           )
                           (vla-put-textstring x (x$subs nstrs ostrs str))
                       )
                    )
                 )
               )
               fns
      )
     (mai_end)
)
;;====================================================================;;
(princ "\n lxx_find = dbx不打开目录文件替换字符(支持多重块)v1.5-----by lxx.2007.4")
(princ)
