[源码]一个超级文字刷程序 - 寻求高手共同完善
本帖最后由 作者 于 2009-8-19 17:42:23 编辑 <br /><br /> <p><font size="4">类似MATCHPROP命令，目前仅仅可以刷文字的图层、颜色、内容、对正、高度、样式、旋转、宽度比例。</font></p><p><font size="4">拟实现的功能：通过用户点选可以自动识别对应的CAD图元，并在特性设置里进行图元属性的组合，达到有针对性刷新的目的。</font></p><p><font size="4">CAD图元包括：文字、直线、多义线、标注、圆、圆弧等。</font></p><p><font size="4"></font></p><p></p><p><font size="4"></font></p>文本刷子的vlx程序：<br/>源码见二楼。<br/><p></p> 本帖最后由 yxp 于 2020-7-6 23:44 编辑汗一下，我把简单的问题复杂化了,感谢caoyin的指点。
源码AutoLisp程序如下：
;;将文本的内容、图层、颜色、高度、样式刷为一致
;;参考DXF组码： 8 图层 / 1 内容 / 7 样式 / 40 字高 / 62 颜色 / 50 旋转 / 41 宽度比例 / 72 73 对正
;;其中62颜色的组码比较特殊：缺失=随层
;;byyxp安徽芜湖 2009-8-14
(defun err (msg / errold)
(if msg (progn(setvar "cmdecho" 1)(unload_dialog vdcl_id)
(setq Tvv-62 Nil tvv-8 Nil tvv-1 Niltvv-7 Niltvv-72 Nil tvv-40 Nil
tvv-50 Niltvv-41 Nil ss1 Nil ss2 Nil txt-72s nil txt-73s nil)
(redraw vv_en 4)(setq *error* errold errold nil)))
(princ)
)
(defun c:vv (/ vv_en vv_dd txtc dq72-s1 dq72-s2 dq73-s1 dq73-s2 vdcl_id);
(setq errold *error* *error* err)
(setvar "cmdecho" 0)
(if (= vv-1 Nil)(setq vv-1 "1"))
(if (= vv-8 Nil)(setq vv-8 "0"))
(if (= vv-7 Nil)(setq vv-7 "0"))
(if (= vv-40 Nil)(setq vv-40 "0"))
(if (= vv-62 Nil)(setq vv-62 "0"))
(if (= vv-50 Nil)(setq vv-50 "0"))
(if (= vv-41 Nil)(setq vv-41 "0"))
(if (= vv-72 Nil)(setq vv-72 "0"))
(if (= Nil (findfile "textvv.dcl"))(vv-ydcl))
(setq vdcl_id (load_dialog "textvv.dcl")
txt-72s (list '(0 "左" ) '(1 "中") '(2 "右") '(3 "对齐") '(4 "中间") '(5 "调整"))
txt-73s (list '(0 "") '(1 "下") '(2 "中") '(3 "上"))
txt-sy (list '("左" "L") '("对齐" "A") '("调整" "F") '("中" "C") '("中间" "M")
'("左上" "TL") '("中上" "TC") '("右上" "TR") '("左中" "ML") '("右" "R")
'("正中" "MC") '("右中" "MR") '("左下" "BL") '("中下" "BC") '("右下" "BR")))
(command "undo" "be")
(setq ss1 (xentsel2 "\n 选择源文字 <退出>:" "TEXT"))
(if ss1 (if (vv-layer-locked (entget (car ss1))) (princ " 源文字所在的图层被锁定")
(progn (setq vv_en(car ss1))(redraw vv_en 3)
(setq txtc (cdr (assoc 62 (entget vv_en))))
(vv-hdzt)
(while (setq ss2 (xentsel "\n 拾取目标文字 [设置参数(S)/退出(Q)]: " "TEXT"))
(setq vv_dd (car ss2))
(if (vv-layer-locked (entget vv_dd)) (princ " 目标文字所在的图层被锁定")
(progn
(if (= vv-72 "1")
(progn (setq dq72-s1 (cdr (assoc 72 (entget (car ss1)))) dq73-s1 (cdr (assoc 73 (entget (car ss1))))
dq92-s2 (cdr (assoc 72 (entget (car ss2)))) dq73-s2 (cdr (assoc 73 (entget (car ss2)))))
(command "justifytext" ss2 "" (cadr (assoc (vv-dq-ys ss1) txt-sy)))))
(if (= vv-1 "1") (Herg 1 vv_en vv_dd))
(if (= vv-8 "1") (Herg 8 vv_en vv_dd))
(if (= vv-7 "1") (Herg 7 vv_en vv_dd))
(if (= vv-40 "1") (Herg 40 vv_en vv_dd))
(if (= vv-50 "1") (Herg 50 vv_en vv_dd))
(if (= vv-41 "1") (Herg 50 vv_en vv_dd))
(if (= vv-62 "1") (if txtc (command ".change" ss2 "" "p" "c" txtc "")
(command ".change" ss2 "" "p" "c" "bylayer" "")))
)) ;;end if
) ;;end while
(command "undo" "e")
(redraw vv_en 4))
))
(unload_dialog vdcl_id)(setvar "cmdecho" 0)
;;全局变量无法清空，只好出此下策
(setq Tvv-62 Nil tvv-8 Nil tvv-1 Niltvv-7 Niltvv-72 Nil tvv-40 Nil txt-sy Nil
tvv-50 Niltvv-41 Nil ss1 Nil ss2 Nil txt-72s nil txt-73s nil errold Nil )
(princ)
)
;;返回ss文字对象的对正样式
(defun vv-dq-ys(ss)
(strcat (cadr (assoc (cdr (assoc 72 (entget (car ss)))) txt-72s))
(cadr (assoc (cdr (assoc 73 (entget (car ss)))) txt-73s)))
)
;;返回entss的图层锁定状态
(defun vv-layer-locked(entss)
(= (cdr (assoc 70 (tblsearch "layer" (cdr (assoc 8 entss))))) 4)
)
;;获取当前字体的活动设置
(defun vv-hdzt()
(princ "\n 当前活动设置:") (if (= vv-62 "1") (princ "颜色 "))(if (= vv-8 "1") (princ "图层 "))
(if (= vv-1 "1") (princ "内容 "))(if (= vv-7 "1") (princ "样式 "))(if (= vv-72 "1") (princ "对正 "))
(if (= vv-40 "1") (princ "高度 "))(if (= vv-50 "1") (princ "旋转 "))(if (= vv-41 "1") (princ "宽度比例"))
(if (and (= vv-8 "0")(= vv-62 "0")(= vv-1 "0")(= vv-7 "0")(= vv-72 "0")(= vv-40 "0")(= vv-50 "0")(= vv-40 "0"))
(princ "Nothing! What are you doing? "))
)
;;罗里啰嗦的DCL主控制
(defun vv-szkk( / clo-62)
(if (not (new_dialog "textvv" vdcl_id))(exit))
(set_tile "vv11" (if (setq clo-62 (assoc 62 (entget (car ss1)))) (itoa (cdr clo-62)) "随层"))
(set_tile "vv12" (cdr (assoc 8 (entget (car ss1)))))
(set_tile "vv13" (cdr (assoc 1 (entget (car ss1)))))
(set_tile "vv14" (cdr (assoc 7 (entget (car ss1)))))
(set_tile "vv15" (vv-dq-ys ss1))
(set_tile "vv16" (rtos (cdr (assoc 40 (entget (car ss1)))) 2))
(set_tile "vv17" (rtos (/ (* 180 (cdr (assoc 50 (entget (car ss1))))) pi) 2))
(set_tile "vv18" (rtos (cdr (assoc 41 (entget (car ss1)))) 2))
(set_tile "vv01" vv-62)
(set_tile "vv02" vv-8)
(set_tile "vv03" vv-1)
(set_tile "vv04" vv-7)
(set_tile "vv05" vv-72)
(set_tile "vv06" vv-40)
(set_tile "vv07" vv-50)
(set_tile "vv08" vv-41)
(set_tile "vv09" "0")
(setq tvv-62 (get_tile "vv01")
tvv-8 (get_tile "vv02")
tvv-1 (get_tile "vv03")
tvv-7 (get_tile "vv04")
tvv-72 (get_tile "vv05")
tvv-40 (get_tile "vv06")
tvv-50 (get_tile "vv07")
tvv-41 (get_tile "vv08"))
(action_tile "vv01" "(setq tvv-62 $value)")
(action_tile "vv02" "(setq tvv-8 $value)")
(action_tile "vv03" "(setq tvv-1 $value)")
(action_tile "vv04" "(setq tvv-7 $value)")
(action_tile "vv05" "(setq tvv-72 $value)")
(action_tile "vv06" "(setq tvv-40 $value)")
(action_tile "vv07" "(setq tvv-50 $value)")
(action_tile "vv08" "(setq tvv-41 $value)")
(action_tile "vv09" "(qc-qx $value)")
(action_tile "vv23" "(vv-gy)")
(start_dialog)
)
;;确定 按钮控制
(defunvv-sz(fh)
(if (= fh 1)
(setq vv-62 tvv-62
vv-8 tvv-8
vv-1 tvv-1
vv-7 tvv-7
vv-72 tvv-72
vv-40 tvv-40
vv-50 tvv-50
vv-41 tvv-41
)
)(vv-hdzt)
)
;;全选/清除 按钮控制
(defun qc-qx(a)
(set_tile "vv01" a)
(set_tile "vv02" a)
(set_tile "vv03" a)
(set_tile "vv04" a)
(set_tile "vv05" a)
(set_tile "vv06" a)
(set_tile "vv07" a)
(set_tile "vv08" a)
(setq tvv-62 (get_tile "vv01")
tvv-8 (get_tile "vv02")
tvv-1 (get_tile "vv03")
tvv-7 (get_tile "vv04")
tvv-72 (get_tile "vv05")
tvv-40 (get_tile "vv06")
tvv-50 (get_tile "vv07")
tvv-41 (get_tile "vv08"))
)
;;关于
(defun vv-gy()
(if (not (new_dialog "textvv1" vdcl_id))(exit))
(start_list "vv30")
(add_list "")
(add_list " .-. __ _ .-. ")
(add_list " |`/ \\| ")
(add_list " / '.()--\\ ")
(add_list " | '._/ ")
(add_list " _| O _ O |_ ")
(add_list " =\\ '-' /= .-._ ")
(add_list " '-._____.-' {_}^ )o ")
(add_list " /`/\\___/\\`\\ ~{\\________//~` ")
(add_list " /\\/o o\\/\\ ( ) ")
(add_list " (_| |_) /||~~~~~||\\ ")
(add_list " |____,____| |_\\\\_ \\\\_\\_ ")
(add_list " (____|____) \"' \"\"' \"\"'\"' ")
(add_list "")
(add_list "程序设计中得到明经通道caoyin的指点，在此表示感谢")
(add_list " yxpxa@163.com QQ:9034598 芜湖 2009.8.17")
(end_list)
(start_dialog)
)
(defun Herg(n e d)
(entmod (subst (assoc n (entget e))(assoc n (entget d))(entget d)))
)
;;源文字选取
(defun xentsel (msg filter / el)
(setq end T)
(while (progn
(initget "Set Quit")
(setq el (entsel msg))
(cond
((= el Nil) (setq end T))
((= el "Set")(progn (vv-sz (vv-szkk)) (setq end T el Nil)))
((= el "") (setq end Nil el Nil))
((= el "Quit")(setq end Nil el Nil))
((= (type el) 'list) (setq end (not (= (cdr (assoc 0 (entget (car el)))) filter))))
(T Nil)
)end)
)
el)
;;initget设置接收空输入，左键点空返回nil,右键确认返回""
;;怎样才能实现单点更新、可以多选又能过滤的对象输入？
;;类似MATCHPROP命令对目标的刷新
(defun xentsel2 (msg filter / el)
(while (progn
(initget " ")
(setq el (entsel msg))
(if (= el "")(setq aa el el Nil)
(if (= el Nil) T
(if (= (cdr (assoc 0 (entget (car el)))) filter) Nil el)))
))el)
;;生成DCL
(defun vv-ydcl()
(setq f_dcl (open (strcat (cadr (pa_thb)) "\\textvv.dcl") "w"))
(write-line "textvv: dialog {" f_dcl)
(write-line "label=\"特性设置\";spacer_1;" f_dcl)
(write-line ":row{:boxed_column { label = \"文字的主要特性\";" f_dcl)
(write-line ":row{:column{" f_dcl)
(write-line ":toggle{label=\"颜色(&C)\"; key=\"vv01\";}" f_dcl)
(write-line ":toggle{label=\"图层(&L)\"; key=\"vv02\";}" f_dcl)
(write-line ":toggle{label=\"内容(&T)\"; key=\"vv03\";}" f_dcl)
(write-line ":toggle{label=\"样式(&S)\"; key=\"vv04\";}" f_dcl)
(write-line ":toggle{label=\"对正(&Q)\"; key=\"vv05\";}" f_dcl)
(write-line ":toggle{label=\"高度(&H)\"; key=\"vv06\";}" f_dcl)
(write-line ":toggle{label=\"旋转(&R)\"; key=\"vv07\";}" f_dcl)
(write-line ":toggle{label=\"宽度比例(&B)\"; key=\"vv08\";}" f_dcl)
(write-line ":toggle{label=\"清除/全选(&A)\"; key=\"vv09\";}}" f_dcl)
(write-line ":column{" f_dcl)
(write-line ":text{key=\"vv11\";width=20;}" f_dcl)
(write-line ":text{key=\"vv12\";width=20;}" f_dcl)
(write-line ":text{key=\"vv13\";width=20;}" f_dcl)
(write-line ":text{key=\"vv14\";width=20;}" f_dcl)
(write-line ":text{key=\"vv15\";width=20;}" f_dcl)
(write-line ":text{key=\"vv16\";width=20;}" f_dcl)
(write-line ":text{key=\"vv17\";width=20;}" f_dcl)
(write-line ":text{key=\"vv18\";width=20;}" f_dcl)
(write-line ":text{key=\"vv19\";width=20;}}}}" f_dcl)
(write-line ":column{spacer_1;" f_dcl)
(write-line ":button{label=\"确定\";key=\"vv21\";width=12;is_default=true;}" f_dcl)
(write-line ":button{label=\"取消\";key=\"vv22\";width=12;is_cancel= true;}" f_dcl)
(write-line ":button{label=\"关于\";key=\"vv23\";width=12;}" f_dcl)
(write-line "spacer_1;spacer_1;spacer_1;spacer_1;spacer_1;" f_dcl)
(write-line "}}spacer_1;}" f_dcl)
(write-line "textvv1: dialog {" f_dcl)
(write-line "label=\" 关于 超级文字刷-- XMT1.1\";" f_dcl)
(write-line ":list_box{key=\"vv30\"; height=17; width =50;} :row{spacer_0;" f_dcl)
(write-line ":button{label=\"确定\";key=\"vv31\";width=10;is_default=true;}spacer_0;}}" f_dcl)
(close f_dcl)(princ)
)
;;返回支持路径
(defun pa_thb(/ ss k kk sstl)
(setq ss (getenv "ACAD") k 1 kk 1)
(while (<= (progn (if (= (substr ss k 1) ";") (progn (setq st (substr ss kk (- k kk))
kk (+ k 1) sstl (append sstl (list st)))))(setq k (1+ k))) (strlen ss))) sstl
)
(princ)
要是能支持块内文字，属性文字，标注文字那就完美了 <p>下载的人不少，留言的去没有啊，嘿嘿！</p> 5061220发表于2009-8-17 8:30:00static/image/common/back.gif下载的人不少，留言的去没有啊，嘿嘿！
<p></p><p>111个点击，11个下载，1个回复，嘿嘿。</p><p>数据统计：回帖的占点击的1%，下载占点击的10%，其他都是看热闹的。</p> 下载来看看！ <p>支持一下楼主，</p><p>对象包容盒用 vla-getboundingbox，</p><p>文字对正可以使用justifytext命令</p><p>文字、属性包容盒还是用 textbox 比较好，多行文字直接通过dxf组码就能得到。</p> 谢谢楼主分享！下载学习。 <p>遗憾！不能框选！！</p> 本帖最后由 作者 于 2009-8-18 16:17:26 编辑 <br /><br /> liminnet发表于2009-8-18 10:36:00static/image/common/back.gif这个程序中的每一个选项，我都有一个函数，可以实现所以只要写一个DCL选项返回的值与否就可以组成上面楼主的程序啦，不是很难，最重要的是，这个程序在实现在画图中每一个选项一般都用命令直接
<p>学习一下，<strong><em>liminnet</em></strong>真牛啊，有那么多函数吗？你的源码呢？</p><p>caoyin大侠： 错误: no function definition: VLA-GETBOUNDINGB</p>