明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 975|回复: 6

分解MTEXT(源码)-非炸开之重写方式

[复制链接]
发表于 2023-1-27 23:38 | 显示全部楼层 |阅读模式
本帖最后由 尘缘一生 于 2023-1-28 01:27 编辑

一直头疼图纸说明,MTEXT文字各段压落问题,
分解MTEXT方法呢,会造成关联其他程序中断,采取重写方式成文,是个好办法
然而,对于重写方式,一直有不好解决的问题,特别是,对于重写一行到底取多少数呢?
考虑从MTEXT的框子宽度,取得这个值,也没想起来怎么取,可能本来MTEXT里就有,这个最大字数的内码在,
发下,谁能给出这个值的取法吗?

  • ;;重写方式分解MTEXT
  • ;;by 尘缘一生 QQ:15290049
  • (defun c:tt ()
  •   (setq nam (car (entsel)))
  •   (setq  
  •     col (ss-getcolor nam) ;;颜色
  •     hi (e-higt nam) ;;高度
  •     ang (e-ang nam nil)
  •     p0 (polar (dxf1 nam 10) (- ang pi2) (* 1.5 hi))
  •     ;;p0 (car (e-box4 enam nil)) ;;垂直文字BUG
  •   )
  •   (if (null (setq ly (dxf1 nam 8))) (setq ly (getvar "clayer")))
  •   (if (null (setq sty (dxf1 nam 7))) (setq sty $hz))
  •   (setq lis (reverse (str->lst (t-string-subst "\\" "\\P" (mtext2text nam)) "\\")))
  • ;(entdel nam) ;测试先注销,发布需要
  •   (repeat (setq j (length lis))
  •     (setq str (nth (setq j (1- j)) lis))
  •     (setq lis1 (reverse (xl-div (sl-str->singleonly str) 46))) ;此处46,为裂解重写一行字数,需要深入研究,如何从MTEXT里,取得这个变值为妙
  •     (repeat (setq n (length lis1))
  •       (setq lis0 (nth (setq n (1- n)) lis1) str0 "")
  •       (repeat (setq i (length lis0))
  •         (setq str0 (strcat (nth (setq i (1- i)) lis0) str0))
  •       )
  •       (entmake (list '(0 . "TEXT") (cons 1 str0) (cons 8 ly) (cons 62 col) (cons 7 sty) (cons 10 p0) (cons 40 hi) (cons 50 ang) (cons 41 0.7)))
  •       (setq p0 (polar p0 (- ang pi2) (* 1.5 hi)))
  •     )
  •   )
  • )
  • ;提取多行文字,去除无用格式符号,但保留分行符\\P-----(一级)------
  • ;返回-->  "4.钢筋的连接要求\\P 钢筋直径d>20mm时,用机..."
  • (defun mtext2text (nam / s ob) ;; (setq s (vlax-get (en2obj (car (entsel))) 'TextString))
  •   (setq s (vlax-get (en2obj nam) 'TextString))
  •   (vlax-put-property (setq ob (vlax-create-object "Vbscript.RegExp")) "IgnoreCase" 0)
  •   (vlax-put-property ob "Global" 1)
  •   (setq s
  •     (mapcar
  •       '(lambda (x y) (vlax-put-property ob "Pattern" x) (setq s (vlax-invoke-method ob "Replace" s y)))
  •       '("\\\\\\\\" "\\\\{" "\\\\}" "\\\\p(.[^;]*);" "\\\\S(.[^;]*)(\\^|#|\\\\)(.[^;]*);"
  •          "(\\\\F|\\\\f|\\\\C|\\\\H|\\\\T|\\\\Q|\\\\W|\\\\A)(.[^;]*);" "(\\\\L|\\\\O|\\\\l|\\\\o)" "\\\\~"
  •          "({|})" "\\x01" "\\x02" "\\x03")
  •       (list (chr 1) (chr 2) (chr 3) "" "" "" "" "" (chr 0) "" "" "\\" "{" "}")
  •     )
  •   )
  •   (if ob (vlax-release-object ob))
  •   (last s)
  • )
  • ;;字符串以旧换新----(一级)----
  • ;;(t-string-subst "毛" "a" "abc")
  • (defun t-string-subst (new old str / n)
  •   (setq n (- (strlen new)))
  •   (while (setq n (vl-string-search old str (min (+ n (strlen new)) (strlen str))))
  •     (setq str (vl-string-subst new old str n))
  •   )
  •   str
  • )
  • ;;字符串转表 str 字符串   sign 分割符号----(一级)---------
  • ;;(str->lst "1 2 3 4" " ")->("1" "2" "3" "4")
  • ;;(str->lst "毛泽东;88;xy;z" ";")->("毛泽东" "88" "xy" "z")
  • ;;(str->lst "毛泽东;88;xy;z" "泽东")->("毛" ";88;xy;z")
  • (defun str->lst (str sign / lst n1 n2 str_1 m2)
  •   (setq lst '())
  •   (setq n1 (strlen str))
  •   (setq n2 (strlen sign))
  •   (while (setq m2 (vl-string-search sign str))
  •     (setq str_1 (substr str 1 m2))
  •     (setq str (substr str (+ 1 m2 n2)))
  •     (if (/= str_1 "")
  •       (setq lst (cons str_1 lst))
  •     )
  •   )
  •   (if (/= str "")
  •     (setq lst (cons str lst))
  •   )
  •   (reverse lst)
  • )
  • ;;字符串转表 中英文拆分为单独文字表-----(一级)------
  • ;;(sl-str->singleonly "12我 的\n毛泽东")  ("1" "2" "我" " " "的" "\n" "毛" "泽" "东")
  • (defun sl-str->singleonly (str / strlst strlst1 hz_str)
  •   (setq  strlst (vl-string->list str) strlst1 '())
  •   (while strlst
  •     (cond
  •       ((and (not hz_str)
  •          (> (car strlst) 159)
  •        )
  •         (setq hz_str (list (car strlst)))
  •         (setq strlst (cdr strlst))
  •       )
  •       ((and hz_str
  •          (> (car strlst) 159)
  •        )
  •         (setq hz_str (append hz_str (list (car strlst))))
  •         (setq strlst (cdr strlst))
  •         (setq strlst1 (append strlst1 (list hz_str)) hz_str nil)
  •       )
  •       ((< (car strlst) 159)
  •         (setq hz_str nil)
  •         (if strlst1
  •           (setq strlst1 (append strlst1 (list (list (car strlst)))))
  •           (setq strlst1 (list (list (car strlst))))
  •         )
  •         (setq strlst (cdr strlst))
  •       )
  •     )
  •   )
  •   (mapcar 'vl-list->string strlst1)
  • )
  • ;;表分组----(一级)----              
  • ;(setq lst'(1 2 3 4 5 6 7 8 9 10 11 12 13))              
  • ;(xl-div lst 3)返回((1 2 3)(4 5 6)(7 8 9)(10 11 12) (13))
  • (defun xl-div (lst n / i rtn)
  •   (while lst
  •     (repeat (min n (length lst))
  •       (setq i (cons (car lst) i) lst (cdr lst))
  •     )
  •     (setq rtn (cons (reverse i) rtn) i nil)
  •   )
  •   (reverse rtn)
  • )
 楼主| 发表于 2023-1-28 00:58 | 显示全部楼层
本帖最后由 尘缘一生 于 2023-1-28 18:41 编辑

想起来一个办法,贴上,用于比较:
  • ;;重写方式分解MTEXT
  • ;;by 尘缘一生 QQ:15290049
  • (defun c:tt (/ nam col hi ang p0 ly sty num0 num j n i lis lis1 lis0 str str0)
  •   (setq nam (car (entsel)))
  •   (setq  
  •     col (ss-getcolor nam) ;;颜色
  •     hi (e-higt nam) ;;高度
  •     ang (e-ang nam nil)
  •     p0 (polar (dxf1 nam 10) (- ang pi2) (* 1.5 hi))
  •     ;;p0 (car (e-box4 enam nil)) ;;垂直文字BUG,舍弃包容盒办法
  •   )
  •   (if (null (setq ly (dxf1 nam 8))) (setq ly (getvar "clayer")))
  •   (if (null (setq sty (dxf1 nam 7))) (setq sty $hz)) ;$hz 全局变量,STYLE
  •   
  •   (setq lis (reverse (str->lst (t-string-subst "\\" "\\P" (mtext2text nam)) "\\")) num0 1)
  • ;(entdel nam) ;测试先注销,发布需要
  •   (repeat (setq j (length lis)) ;取得最大每行写多少字
  •     (setq num (numstr (nth (setq j (1- j)) lis))) ;(strlen "毛") 2
  •     (if (<= num num0) (setq num num0))
  •     (setq num0 num)
  •   )
  •   (repeat (setq j (length lis))
  •     (setq str (nth (setq j (1- j)) lis))
  •     (setq lis1 (reverse (xl-div (sl-str->singleonly str) num)))
  •     (repeat (setq n (length lis1))
  •       (setq lis0 (nth (setq n (1- n)) lis1) str0 "")
  •       (repeat (setq i (length lis0))
  •         (setq str0 (strcat (nth (setq i (1- i)) lis0) str0))
  •       )
  •       (entmake (list '(0 . "TEXT") (cons 1 str0) (cons 8 ly) (cons 62 col) (cons 7 sty) (cons 10 p0) (cons 40 hi) (cons 50 ang) (cons 41 0.7)))
  •       (setq p0 (polar p0 (- ang pi2) (* 1.5 hi)))
  •     )
  •   )
  • )
  • ;;字符文字串逻辑长度值-----(一级)-----
  • (defun numstr (str / ns lis n num1)
  •   (setq ns 0 lis (sl-str->singleonly str))
  •   (repeat (setq n (length lis))
  •     (setq num1 (nth (setq n (1- n)) lis))
  •     (cond
  •       ((or (< (ascii num1) 97) (and (> (ascii num1) 122) (<= (ascii num1) 128)))
  •         (setq ns (1+ ns))
  •       )
  •       ((and (>= (ascii num1) 97) (< (ascii num1) 122)) ;小写英文字母
  •         (setq ns (1+ ns))
  •       )
  •       ((> (ascii num1) 128) ;;汉字
  •         (setq ns (+ ns 2))
  •       )
  •     )
  •   )
  •   ns
  • )



备注下:这段代码,测试失败,不行,不可用
发表于 2023-1-28 09:08 | 显示全部楼层
沙发,新年刚过就发帖了,楼主实在是敬业啊
发表于 2023-1-28 11:27 | 显示全部楼层
no function definition: SSGETCOLOR
发表于 2023-1-28 14:16 | 显示全部楼层
谢谢楼主分享
 楼主| 发表于 2023-1-28 18:39 | 显示全部楼层
本帖最后由 尘缘一生 于 2023-1-28 18:50 编辑
ju5027 发表于 2023-1-28 11:27
no function definition: SSGETCOLOR

这些看字面不很明白吗,有些涉及集成,实际很简单,集成的并不是特意为之,实际是,兼容性问题,那些函数只不过是确保不同实体的正确性,对于MTEXT来说,可以如此处理。。。


  • ;;重写方式分解炸开MTEXT----(一级)------
  • ;;ss 返回炸开后TEXT选择集
  • (defun expmtext (nam / col hi ang p0 ly sty j n i lis lis1 lis0 str str0 ss)
  •   (setq  
  •     ss (ssadd)
  •     col (dxf1 nam 62) ;;颜色
  •     hi (dxf1 nam 40) ;;高度
  •     ang (dxf1 nam 50) ;锐角弧度
  •   )
  •   (setq p0 (cadddr (e-box4 nam t))) ;取包容盒左上角
  •   (if (null (setq ly (dxf1 nam 8))) (setq ly (getvar "clayer")))
  •   (if (null (setq sty (dxf1 nam 7))) (setq sty $hz))  
  •   (setq lis (reverse (str->lst (t-string-subst "\\" "\\P" (gets-mt-p nam)) "\\")))
  •   (entdel nam)
  •   (repeat (setq j (length lis))
  •     (setq str (nth (setq j (1- j)) lis))
  •     (setq lis1 (reverse (xl-div (sl-str->singleonly str) 56)))
  •     (repeat (setq n (length lis1))
  •       (setq lis0 (nth (setq n (1- n)) lis1) str0 "")
  •       (repeat (setq i (length lis0))
  •         (setq str0 (strcat (nth (setq i (1- i)) lis0) str0))
  •       )
  •       (entmake ;左上定位文字
  •         (list '(0 . "TEXT") (cons 1 str0) (cons 8 ly) (cons 62 col) (cons 7 sty) (cons 10 (polar p0 (- ang pi2) hi)) (cons 40 hi)
  •           (cons 72 0) (cons 11 p0) (cons 73 3)(cons 50 ang) (cons 41 0.7)
  •         )
  •       )
  •       (entmod (emod (emod (entget (entlast)) 72 0) 73 0)) ;转左下定位,按需
  •       (ssadd (entlast) ss)
  •       (setq p0 (polar p0 (- ang pi2) (* 1.5 hi)))
  •     )
  •   )
  •   ss
  • )


  • ;取得图元参数值内容-----(一级)-------
  • ;;(setq h (dxf1 ent 40))
  • ; ent 为实体名或实体entget,
  • (defun dxf1 (ent i / tmp)
  •   (if (= (type ent) 'ENAME)
  •     (setq ent (entget ent '("*")))
  •   )
  •   (setq tmp (cdr (assoc i ent)))
  •   (if (null tmp)
  •     (cond
  •       ((= i 66) 0)
  •       ((= i 48) (getvar "celtscale"))
  •       ((= i 62) 256)
  •       ((= i 370) (setq tmp -1))
  •       ((= i 6) "ByLayer")
  •     )
  •     tmp  
  •   )



发表于 2023-2-3 09:44 | 显示全部楼层
非常不错的代码,谢谢楼主分享啊。
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-28 20:21 , Processed in 0.222304 second(s), 22 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表