文字加框问题（用于结构设计）
本帖最后由 涛涛_1048 于 2019-7-9 01:26 编辑最近在论坛上看到一个程序，可以给文字加框。主要是对特定的计算数据加一个标识。不过对于水平的文字，可以完美的加上框，对于竖向的文字，这个框也是画成了水平的，请高手给修改一下程序。也对原来该程序的作者表示敬意。
本程序首先按图层找到文字，然后检查该文字是否含有“G”标志，然后对"G"后两个数字与设定数值进行比较，只要两个数字中有一个大于设定值，就给该文字加框。
现将该程序与图纸上传，请论坛各位同仁修改一下。
(defun c:cgj (/ bb cc en en_data fjm hh i jm k os p1 p11 p2 p22 pc ss str txt DD)
(setvar "CMDECHO" 0)
(setq os (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq str (getstring "\n缺省配箍值<G1.0-0.5(#8@100200)>:"))
(if (= str "") (setq str "G1.0-0.5"))
(setq jm (atof (substr str 2 3)) fjm (atof (substr str 6 3)))
(setq ss (ssget '((0 . "text") (8 . "Pkpm_层15220"))))
(setq i 0 k 0)
(command "LAYER" "m" "CGJ" "C" 1 "CGJ" "")
(repeat (sslength ss)
(setq en (ssname ss i))
(setq en_data (entget en))
(setq txt (cdr (assoc 1 en_data)))
(setq bb (substr txt 2 3) cc (substr txt 6 3) DD (substr txt 1 1))
(if (AND (= DD "G") (or (> (atof bb) jm) (> (atof cc ) fjm)))
(progn
(setq p1 (cdr (assoc 10 en_data)) ang (cdr (assoc 50 en_data)) hh (cdr (assoc 40 en_data)))
(setq pc (cadr (textbox en_data)))
(setq p2 (mapcar '+ p1 pc))
(setq hh (* 0.1 hh))
(setq p11 (mapcar '- p1 (list hh hh)) p22 (mapcar '+ p2 (list hh hh)))
(command "rectangle" p11 p22)
(if (= ang (/ pi 2)) (command "rotate" (entlast)p1 (/ pi 2)))
(setq k (+ 1 k))
)
)
(setq i (+ 1 i))
)
(princ (strcat "\n共找到超过缺省配箍值<" str "> " (itoa k)" 项。 "))
(setvar "OSMODE" os)
)
希望图4的文字框变成如图5的样子。wpj3文件是测试图。
;;;文字边框
(defun get-mtextbox
(en txtsize BoxType / txtEntData PtTL xWidth xHeight xAngle Pt_TC PtTR PtTR Pt_BL Pt_BC Pt_BR Pt_MC)
(setq txtEntData (entget en))
(setq PtTL (cdr (assoc 10 txtEntData))
xWidth (cdr (assoc 42 txtEntData))
xHeight (cdr (assoc 43 txtEntData))
xAngle (cdr (assoc 50 txtEntData))
Pt_TC (polar PtTL xAngle (* xWidth 0.5))
PtTR (polar PtTL xAngle xWidth)
Pt_BL (polar PtTL (- xAngle (/ PI 2.0)) xHeight)
Pt_BC (polar Pt_BL xAngle (* xWidth 0.5))
Pt_BR (polar Pt_BL xAngle xWidth)
Pt_MC (polar Pt_BL
(angle Pt_BL PtTR)
(/ (distance Pt_BL PtTR) 2.0)
)
) ;endsetq
;(setq xAngle (cdr (assoc 50 txtEntData)))
(setq Pt_BL (polar Pt_BL xAngle (- txtsize)))
(setq Pt_BL (polar Pt_BL (+ xAngle (/ PI 2.0)) (- txtsize)))
(setq Pt_BR (polar Pt_BR xAngle txtsize))
(setq Pt_BR (polar Pt_BR (+ xAngle (/ PI 2.0)) (- txtsize)))
(setq PtTL (polar PtTL xAngle (- txtsize)))
(setq PtTL (polar PtTL (+ xAngle (/ PI 2.0)) txtsize))
(setq PtTR (polar PtTR xAngle txtsize))
(setq PtTR (polar PtTR (+ xAngle (/ PI 2.0)) txtsize))
(cond
;((= BoxType "C")(vl-cmdf "_Circle" Pt_MC (+ (/ (max (cadadr pt)(caadr pt)) 2.0) txtsize)))
((= BoxType "C")(vl-cmdf "_Circle" Pt_MC (/ (distance Pt_BL PtTR) 2.0)))
((= BoxType "R")(vl-cmdf "_PLine" Pt_BL Pt_BR PtTR PtTL "C"))
((= BoxType "S")(vl-cmdf "_PLine" Pt_BL Pt_BR "a" PtTR "l" PtTL "a""Cl"))
);COND
)
;text
(defun get-textbox (en offset / pt1 pt2 pt3 pt4 a b c d PT pts end pt_mc)
;(setq en (car (entsel)))
;(setq offset 1)
(setq end (entget en))
(setq pts (cdr (assoc 10 end)))
(setq a (cdr (assoc 50 end)))
(setq b (* (/ PI 180) 225))
(SETQ C (+ A B))
(setq d (sqrt (+ (* offset offset) (* offset offset))))
(setq pt (textbox end))
(setq pt1 (polar pts c d))
(setq b (* (/ PI 180) 45))
(SETQ C (+ A B))
(setq pt2 (polar pt1 a (+ (caadr pt) offset offset)))
(setq pt3 (polar pt2 (+ a (* pi 0.5)) (+ (cadadr pt) offset offset)))
(setq pt4 (polar pt1 (+ a (* pi 0.5)) (+ (cadadr pt) offset offset)))
(setq pt_mc (polar pt1 (angle Pt1 Pt3) (/ (distance Pt1 Pt3) 2.0)))
(cond
;((= BoxType "C")(vl-cmdf "_Circle" Pt_MC (+ (/ (max (cadadr pt)(caadr pt)) 2.0) txtsize)))
((= BoxType "C")(vl-cmdf "_Circle" Pt_MC (/ (distance Pt1 Pt3) 2.0)))
((= BoxType "R")(command "pline" pt1 pt2 pt3 pt4 "c"))
((= BoxType "S")(command "pline" pt1 pt2"A" pt3"L" pt4 "A""cL"))
);COND
)
(princ "\n 使用命令: wzbk")
(defun c:wzbk (/ cmd0 osmode0 ss s seconds s n nn en endata txtEntType txtsize)
(PRINC "\n【阳羡刚刚好CAD外挂<文字边框功能>】---给所选文字加上圆框/椭圆框/矩形框")(PRINC)
(setq cmd0 (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq osmode0 (getvar "OSMODE"));捕捉
(setvar "OSMODE" 0);捕捉
(vl-cmdf "_.undo" "_be")
(if (not #AY_TBOXBOXTYPE)(setq #AY_TBOXBOXTYPE "S"))
(initget "C S R")
(setq BoxType (getkword (strcat "\n边框类型 [圆形(C)/圆矩形(S)/矩形(R)]<" #AY_TBOXBOXTYPE ">: ")))
(if (= BoxType nil) (setq BoxType #AY_TBOXBOXTYPE) (setq #AY_TBOXBOXTYPE BoxType))
(if (setq ss (ssget '((0 . "*TEXT"))))
(progn
(setq s (getvar "DATE"))
(setq seconds (* 86400.0 (- s (fix s))))
(setq n 0);setq
(setq nn (sslength ss))
(repeat nn
(setq en (ssname ss n));setq
(setq endata (entget en))
(setq txtEntType (cdr (assoc 0 endata)))
(setq txtsize (cdr (assoc 40 endata)))
(setq txtsize (* (/ txtsize 2.5) 0.6))
(if (= txtEntType "TEXT")(get-textbox en txtsize));IF
(if (= txtEntType "MTEXT")(get-mtextbox en txtsize BoxType));IF
(setq n (1+ n))
(SETVAR "MODEMACRO" (strcat "** 已完成 "(rtos (* 100 (/ (+ 0.01 n) nn)) 2 0) "% **"))
);repeat
(setq s (getvar "DATE"))
(setq seconds2 (* 86400.0 (- s (fix s))))
(princ (strcat "\n 文字加框完成共耗时" (rtos (- seconds2 seconds) 2 3)"秒"))
);progn
(princ "\n没有选定有效的对象.")
);if
(vl-cmdf "_.undo" "_e")
(SETVAR "MODEMACRO" "")
(setvar "cmdecho" cmd0)
(setvar "OSMODE" osmode0)
(princ)
)
借花献佛 ;;简单改了下
;;涉及到旋转角度，可能会受某些系统变量值的影响，比如ANGBASE或者ANGDIR，不严谨
;;可以考虑下用多行文字，多行文字本身有加框的选项
;;还有一些细节的地方你自己再看看
(defun c:cgj (/ ANG BB CC DD EN EN_DATA FJM HH I JM K P1 P11 P2 P22 PC SS STR TXT)
(setvar "CMDECHO" 0)
(setq str (getstring "\n缺省配箍值<G1.0-0.5(#8@100200)>:"))
(if (= str "")
(setq str "G1.0-0.5")
)
(setq jm(atof (substr str 2 3))
fjm (atof (substr str 6 3))
)
(setq ss (ssget '((0 . "text") (8 . "Pkpm_层15220"))))
(setq i 0
k 0
)
(vl-cmdf "LAYER" "m" "CGJ" "C" 1 "CGJ" "")
(repeat (sslength ss)
(setq en (ssname ss i))
(setq en_data (entget en))
(setq txt (cdr (assoc 1 en_data)))
(setq bb (substr txt 2 3)
cc (substr txt 6 3)
DD (substr txt 1 1)
)
(if (AND (= DD "G") (or (> (atof bb) jm) (> (atof cc) fjm)))
(progn
(setq pc (textbox en_data)
p1 (cdr (assoc 10 en_data))
p2 (mapcar '+ p1 (cadr pc))
hh (cdr (assoc 40 en_data))
hh (* 0.1 hh)
ang (cdr (assoc 50 en_data))
)
(setq p11 (mapcar '- p1 (list hh hh))
p22 (mapcar '+ p2 (list hh hh))
)
(vl-cmdf "_.rectang" "_non" p11 p22)
(if (equal ang (/ pi 2) 1e-5) (vl-cmdf "_.rotate" (entlast) "" "_non" p1 -90))
(setq k (+ 1 k))
)
)
(setq i (+ 1 i))
)
(princ (strcat "\n共找到超过缺省配箍值<" str "> " (itoa k) " 项。 "))
)
本帖最后由 1291500406 于 2019-7-10 11:56 编辑
涛涛_1048 发表于 2019-7-9 18:41
6楼的必强同学，在论坛里看到你写了好多程序，尤其是在工具箱方面，请必强同学也写一下吧。
(defun c:bb( / bbset bb b bb5 bb4 bb2ss i en max maxa min mina)(vl-load-com)
(setq bbset(getreal"\n必强提示输入设定值")bb(ssget ":s" '((0 . "text")(1 . "G*-*"))) b -1 i -1 bb5 (ssadd))
(repeat (sslength bb)(setq b (1+ b) bb4 (ssname bb b) bb2 (cdr(assoc 1 (entget bb4))))
(if(or(< bbset (atof(substr bb2 2 3)))(< bbset (atof(substr bb2 7 2))))(setq ss (ssadd bb4 bb5))))
(repeat (sslength ss) (setq en (ssname ss (setq i(+ i 1))))(vla-getboundingbox (vlax-ename->vla-object en) 'a 'b)
(setq max (vlax-safearray->list a) min (vlax-safearray->list b))(setq maxa (list (car max)(cadr min)) mina (list (car min)(cadr max)))
(entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity")'(100 . "AcDbPolyline") '(62 . 7) '(90 . 12) (cons 10 max) '(40 . 0) '(41 . 0)
(cons 10 max)(cons 62 2)(cons 8 "文字框")(cons 10 maxa)(cons 10 min)(cons 10 mina)(cons 10 max))))(princ))
ssget 中可以设定过滤字符为 "G*-*"
用textbox函数获得text的边框数据，然后绘制外框即可。
可能还有任意角度的，按text的rotate angle旋转。
还有考虑UCS，对这些数据进行坐标系转换。
希望能增加一个功能 文字加圆框 依然小小鸟 发表于 2019-7-9 10:13
希望能增加一个功能 文字加圆框
用文字的最小包围盒坐标画框不是很简单么？横竖都行。 依然小小鸟 发表于 2019-7-9 10:13
希望能增加一个功能 文字加圆框
计算中心，半径，画圆 2楼和5楼的同仁给写一下吧，直接用文字边框的数据的。 非常感谢二楼的这位同仁，在百忙中回复了帖子。不过就是程序还是运行不正常。 6楼的必强同学，在论坛里看到你写了好多程序，尤其是在工具箱方面，请必强同学也写一下吧。 没搞懂这样加框有什么好处
页:
[1]
2