; 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$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 / x doc cname ret verkey 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)
						)
					)
				)
			)
			;(setq llays (mai_unlock_alllayer))
			(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)
				;; 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 llays (mai_unlock_alllayer))
			;;
			(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)
			;(mai_relock_layers 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 cdoc )

	(princ (if (equal doc cdoc) "(*当前文件*)" "(*已打开文件*)"))
	;;激活已打开文件..->>>>>bug, vlisp先天缺陷? 不能跨文档
	(vla-Activate doc)
	;;处理*text
	(setq ss (ssget "x" (list (cons 0 "*TEXT") (cons 1 fil))))
	(foreach e (mai_ssget_2_list ss)
		(setq 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
				(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)
					)
				)
			)
			(and regkey
				(< 0 (vla-get-count x))
				(setq ssblk (ssget "x" (list (cons 0 "INSERT") (cons 2 (vla-get-name x)))))
				(foreach e (mai_ssget_2_list ssblk) (entupd e))
			)
		)
	)
	(princ "\n .......块内文字处理完毕.")
	;;处理块属性.
	(setq ss (ssget "x" (list (cons 0 "INSERT") (cons 66 1))))
	(foreach e (mai_ssget_2_list ss)
		(setq 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$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 (mai_str_replace str x y))) 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"))
	(or *dir (setq *dir (getvar "DWGPREFIX")))
	(setq
		vcol '(modelspace paperspace blocks)
		cname (strcat (getvar "DWGPREFIX") (getvar "DWGNAME"))
	)
	(cond
		(	(= pathkey "3") (setq fns (list cname)))
		(	(= pathkey "2")
			(setq fns (mai_GetFiles "选择需要替换字符的dwg,dxf文件" (cond (*dir) (mai_mini_path)) "dwg,dxf"))
			(if fns (setq *dir (strcat (vl-filename-directory (car fns)) "\\")))
		)
		(	(setq fpath (mai_Getdir "选择要处理的文件所在目录" mai_mini_path));取目录函数.
			(setq
				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 / str )
					(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)
