文字加框问题（用于结构设计）

涛涛_1048 · 发表于 2019-7-9 01:21:05

本帖最后由涛涛_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文件是测试图。

注册 · 发表于 2022-12-7 07:14:44

;;; 文字边框
(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)
 )
借花献佛

satan421 · 发表于 2019-7-9 08:58:33

;;简单改了下
;;涉及到旋转角度，可能会受某些系统变量值的影响，比如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) " 项。 "))
)

(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 10:11:00

本帖最后由 1291500406 于 2019-7-10 11:56 编辑

涛涛_1048 发表于 2019-7-9 18:41
6楼的必强同学，在论坛里看到你写了好多程序，尤其是在工具箱方面，请必强同学也写一下吧。

(defun c:bb( / bbset bb b bb5 bb4 bb2 ss 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))

e2002 · 发表于 2019-7-9 09:49:52

ssget 中可以设定过滤字符为 "G*-*"
用textbox函数获得text的边框数据，然后绘制外框即可。
可能还有任意角度的，按text的rotate angle旋转。
还有考虑UCS，对这些数据进行坐标系转换。

依然小小鸟 · 发表于 2019-7-9 10:13:15

希望能增加一个功能文字加圆框

mikewolf2k · 发表于 2019-7-9 13:19:08

依然小小鸟发表于 2019-7-9 10:13
希望能增加一个功能文字加圆框

用文字的最小包围盒坐标画框不是很简单么？横竖都行。

1291500406 · 发表于 2019-7-9 15:46:37

依然小小鸟发表于 2019-7-9 10:13
希望能增加一个功能文字加圆框

计算中心，半径，画圆

涛涛_1048 · 发表于 2019-7-9 18:39:08

2楼和5楼的同仁给写一下吧，直接用文字边框的数据的。

涛涛_1048 · 发表于 2019-7-9 18:39:55

非常感谢二楼的这位同仁，在百忙中回复了帖子。不过就是程序还是运行不正常。

涛涛_1048 · 发表于 2019-7-9 18:41:20

6楼的必强同学，在论坛里看到你写了好多程序，尤其是在工具箱方面，请必强同学也写一下吧。

clinber · 发表于 2019-7-10 08:28:07

没搞懂这样加框有什么好处

账号		自动登录	找回密码
密码			注册

[提问] 文字加框问题（用于结构设计）

本帖子中包含更多资源