明经CAD社区

 找回密码
 注册

扫一扫,访问微社区

QQ登录

只需一步,快速开始

查看: 116|回复: 2

[提问] 请高手帮满修改一下,文字交换程序,使他支持天正

[复制链接]
发表于 2019-10-5 10:54 | 显示全部楼层 |阅读模式
本帖最后由 tranney 于 2019-10-5 10:55 编辑

有朋友帮忙修改一下么?使得文字交换程序能够支持天正等文字吗?下面的文字刷是可以支持天正程序的,
我觉得是可以达到,但是我功力不行,有请高手捉刀!!

附:文字交换程序
(defun c:zh (/ ent1 ent2 ent1_date ent2_date old_wz_list new_wz_list
                                                                         old3_wz_list new3_wz_list
                                                                 )
        (princ "\n文字工具 交换两个文字的内容")
        (setq ent1 (entsel "\n 请选择要交换内容文字-1:"))
        (setq ent1_date (entget (car ent1)))
        (setq old_wz_list (assoc 1 ent1_date))
        (princ old_wz_list)
        (setq ent2 (entsel "\n 请选择要交换内容文字-2:"))
        (setq ent2_date (entget (car ent2)))
        (setq new_wz_list (assoc 1 ent2_date))
        (princ new_wz_list)
        (setq new3_wz_list new_wz_list)
        (setq old3_wz_list old_wz_list)
        (setq ent1_date (subst
                                                                                new3_wz_list
                                                                                old_wz_list
                                                                                ent1_date
                                                                        )
        )
        (setq ent2_date (subst
                                                                                old3_wz_list
                                                                                new_wz_list
                                                                                ent2_date
                                                                        )
        )
        (entmod ent1_date)
        (entmod ent2_date)
        (princ)
)


;----------  文本内容格式刷(支持天正) 开始
;;; -------------------------------------------------------------------------
;;; 文本内容刷V3.0  命令zs     --by 阿甘 2016.04
;;; 支持块中文字(块中文字只能点选,其它文字可以框选)、单行文字、多行文字、天正文字、天正图名、天正标高、属性文字、块中属性文字
(vl-load-com)
(setq source_text nil) ; 设源文字为全局变量
(defun c:Zcai_zs (/ en en_data en1 en1_data ent entype entype_source i ob pt ss ss_data txtst *error* x)
  (defun *error* (x) ;出错函数
                (if en (redraw (car en) 4))
                (setvar "ErrNo" 0)
                (setvar "cmdecho" 1)
  )
  (setvar "cmdecho" 0)
  (setvar "ErrNo" 0)
  (princ"\n排水工具: 三大刷子之文字刷子")
  (if (= source_text nil)
    (if (setq en (nentsel "\n请选择源文字(右键退出):"))
                        (progn
                                (setq en_data (entget (car en)))
                                (setq entype_source (cdr (assoc 0 en_data)))
                                (if (or (setq txtst (cdr (assoc 7 en_data))) (= entype_source "TCH_DRAWINGNAME"))
                                        (progn
                                                (redraw (car en) 3)
                                                (if (= entype_source "ATTDEF") ;如果是属性字,则取“标记”为源文字
                                                        (setq source_text (cdr (assoc 2 en_data)))
                                                        (setq source_text (cdr (assoc 1 en_data)))
                                                )
                                        ))
                        )
    )
    (if (and (= (setq en (nentsel (strcat "\n请选择源文字: 默认:" source_text))) nil) (= (getvar "ErrNo") 52))
      (progn
                                (setvar "ErrNo" 0)
                                (setq txtst T)
      )
      (if en
                                (progn
                                        (setq en_data (entget (car en)))
                                        (setq entype_source (cdr (assoc 0 en_data)))
                                        (if (or (setq txtst (cdr (assoc 7 en_data))) (= entype_source "TCH_DRAWINGNAME"))
                                                (progn
                                                        (redraw (car en) 3)
                                                        (if (= entype_source "ATTDEF") ;如果是属性字,则取“标记”为源文字
                                                                (setq source_text (cdr (assoc 2 en_data)))
                                                                (setq source_text (cdr (assoc 1 en_data)))
                                                        )
                                                ))
                                )
                                (setvar "ErrNo" 52)
                        )
    )
  )
  (if (or txtst (= entype_source "TCH_DRAWINGNAME"))
                (progn
                        (prompt "\n请选择要修改内容的文字:")
                        (while (/= (getvar "ErrNo") 52)
                                (prompt (strcat "\n文字内容将被刷成:" source_text))
                                (if (and (setq ss (ssget ":S" '((0 . "*TEXT,TCH_DRAWINGNAME,TCH_ELEVATION,INSERT,ATTDEF,ATTRIB")))) source_text)
                                        (progn
                                                (if (= (caar (setq ss_data (ssnamex ss 0))) 1)
                                                        (progn                       ; 点选时
                                                                (setq ent (ssname ss 0)
                                                                        pt (trans (cadr (last (car ss_data))) 0 1)
                                                                        en1 (car (nentselp pt))
                                                                        en1_data (entget en1)
                                                                        entype (cdr (assoc 0 en1_data))
                                                                        ob (vlax-ename->vla-object en1)
                                                                )
                                                                (wenzishua entype entype_source ob source_text en1 ent)
                                                        )
                                                        (progn                       ; 框选时
                                                                (setq i 0)
                                                                (repeat (sslength ss)
                                                                        (setq en1 (ssname ss i)
                                                                                ent en1
                                                                                en1_data (entget en1)
                                                                                entype (cdr (assoc 0 en1_data))
                                                                                ob (vlax-ename->vla-object en1)
                                                                        )
                                                                        (wenzishua entype entype_source ob source_text en1 ent)
                                                                        (setq i (1+ i))
                                                                )                               ; end repeat
                                                        )
                                                )
                                        )
                                )
                        ); end while
                ))
  (if en (redraw (car en) 4))
  (setvar "ErrNo" 0)
  (setvar "cmdecho" 1)
  (princ)
)

;文字刷子程序
(defun wenzishua (entype entype_source ob source_text en1 ent)
  ; cad多行文字
  (if (= entype "MTEXT")
    (progn
      (vla-put-TextString ob source_text)
      (entupd en1)
      (entupd ent)
    )
  )
  ;去掉多行文字无用格式符号
  (if (= entype_source "MTEXT")
    (setq source_text (mtext2text source_text))
  )
  ; cad单行文字
  (if (= entype "TEXT")
    (progn
      (vla-put-TextString ob source_text)
      (entupd en1)
      (entupd ent)
    )
  )
  ; 天正文字的内容格式刷
  (if (or
                                (= entype "TCH_TEXT")
                                (= entype "TCH_ELEVATION")
      )
    (progn
      (vlax-put-property ob 'Text source_text)
      (entupd en1)
      (entupd ent)
    )
  )   
  ; 天正图名、标高的内容格式刷
  (if (= entype "TCH_DRAWINGNAME")
    (progn
      (vlax-put-property ob 'NameText source_text)
      (entupd en1)
      (entupd ent)
    )
  )
  ; 属性文字 只改"标记"
  (if (= entype "ATTDEF")
    (progn
      (vla-put-TagString ob source_text);改标记
      (entupd en1)
      (entupd ent)
    )
  )
  ; 块中属性文字 只改"默认"
  (if (= entype "ATTRIB")
    (progn
      (vla-put-TextString ob source_text);改默认
      (entupd en1)
      (entupd ent)
    )
  )
)

;提取多行文字,去除无用格式符号--来自明经
(defun mtext2text(MTextString / regex s)
  (setq regex(vlax-create-object "Vbscript.RegExp")) ;引用正则表达式控件
  (vlax-put-property regex "IgnoreCase" 0) ;不忽略大小写
  (vlax-put-property regex "Global" 1) ;匹配方式,全文字匹配
  (setq s MTextString)
        ;替换\\字符
  (vlax-put-property regex "Pattern" "\\\\\\\\")
  (setq s(vlax-invoke-method  regex "Replace" s (chr 1)))
        ;替换\{字符
  (vlax-put-property regex "Pattern" "\\\\{")
  (setq s(vlax-invoke-method  regex "Replace" s (chr 2)))
        ;替换\}字符
  (vlax-put-property regex "Pattern" "\\\\}")
  (setq s(vlax-invoke-method  regex "Replace" s (chr 3)))
        ;删除段落缩进格式
  (vlax-put-property regex "Pattern" "\\\\pi(.[^;]*);")
  (setq s(vlax-invoke-method  regex "Replace" s ""))
        ;删除制表符格式
  (vlax-put-property regex "Pattern" "\\\\pt(.[^;]*);")
  (setq s(vlax-invoke-method  regex "Replace" s ""))
        ;删除堆迭格式
  (vlax-put-property regex "Pattern" "\\\\S(.[^;]*)(\\^|#|\\\\)(.[^;]*);")
  (setq s(vlax-invoke-method  regex "Replace" s ""))
        ;删除字体、颜色、字高、字距、倾斜、字宽、对齐格式
  (vlax-put-property regex "Pattern" "(\\\\F|\\\\f|\\\\C|\\\\H|\\\\\T|\\\\Q|\\\\W|\\\\A)(.[^;]*);")
  (setq s(vlax-invoke-method  regex "Replace" s ""))
        ;删除下划线、删除线格式
  (vlax-put-property regex "Pattern" "(\\\\L|\\\\O|\\\\l|\\\\o)")
  (setq s(vlax-invoke-method  regex "Replace" s ""))
        ;删除不间断空格格式
  (vlax-put-property regex "Pattern" "\\\\~")
  (setq s(vlax-invoke-method  regex "Replace" s ""))
        ;删除换行符格式
  (vlax-put-property regex "Pattern" "\\\\P")
  (setq s(vlax-invoke-method  regex "Replace" s ""))
        ;删除换行符格式(针对Shift+Enter格式)
  (vlax-put-property regex "Pattern" "\n")
  (setq s(vlax-invoke-method  regex "Replace" s ""))
        ;删除{}
  (vlax-put-property regex "Pattern" "({|})")
  (setq s(vlax-invoke-method  regex "Replace" s ""))
        
        ;替换回\\,\{,\}字符
  (vlax-put-property regex "Pattern" "\\x01")
  (setq s(vlax-invoke-method  regex "Replace" s "\\"))
  (vlax-put-property regex "Pattern" "\\x02")
  (setq s(vlax-invoke-method  regex "Replace" s "{"))
  (vlax-put-property regex "Pattern" "\\x03")
  (setq s(vlax-invoke-method  regex "Replace" s "}"))
        
  (vlax-release-object regex)
  s
)



发表于 2019-10-5 13:23 | 显示全部楼层
本帖最后由 lxw320 于 2019-10-5 13:26 编辑



这样多好看!

附:文字交换程序[code="lisp]
  1. (defun c:zh (/ ent1 ent2 ent1_date ent2_date old_wz_list new_wz_list
  2.                                                                          old3_wz_list new3_wz_list
  3.                                                                  )
  4.         (princ "\n文字工具 交换两个文字的内容")
  5.         (setq ent1 (entsel "\n 请选择要交换内容文字-1:"))
  6.         (setq ent1_date (entget (car ent1)))
  7.         (setq old_wz_list (assoc 1 ent1_date))
  8.         (princ old_wz_list)
  9.         (setq ent2 (entsel "\n 请选择要交换内容文字-2:"))
  10.         (setq ent2_date (entget (car ent2)))
  11.         (setq new_wz_list (assoc 1 ent2_date))
  12.         (princ new_wz_list)
  13.         (setq new3_wz_list new_wz_list)
  14.         (setq old3_wz_list old_wz_list)
  15.         (setq ent1_date (subst
  16.                                                                                 new3_wz_list
  17.                                                                                 old_wz_list
  18.                                                                                 ent1_date
  19.                                                                         )
  20.         )
  21.         (setq ent2_date (subst
  22.                                                                                 old3_wz_list
  23.                                                                                 new_wz_list
  24.                                                                                 ent2_date
  25.                                                                         )
  26.         )
  27.         (entmod ent1_date)
  28.         (entmod ent2_date)
  29.         (princ)
  30. )


  31. ;----------  文本内容格式刷(支持天正) 开始
  32. ;;; -------------------------------------------------------------------------
  33. ;;; 文本内容刷V3.0  命令zs     --by 阿甘 2016.04
  34. ;;; 支持块中文字(块中文字只能点选,其它文字可以框选)、单行文字、多行文字、天正文字、天正图名、天正标高、属性文字、块中属性文字
  35. (vl-load-com)
  36. (setq source_text nil) ; 设源文字为全局变量
  37. (defun c:Zcai_zs (/ en en_data en1 en1_data ent entype entype_source i ob pt ss ss_data txtst *error* x)
  38.   (defun *error* (x) ;出错函数
  39.                 (if en (redraw (car en) 4))
  40.                 (setvar "ErrNo" 0)
  41.                 (setvar "cmdecho" 1)
  42.   )
  43.   (setvar "cmdecho" 0)
  44.   (setvar "ErrNo" 0)
  45.   (princ"\n排水工具: 三大刷子之文字刷子")
  46.   (if (= source_text nil)
  47.     (if (setq en (nentsel "\n请选择源文字(右键退出):"))
  48.                         (progn
  49.                                 (setq en_data (entget (car en)))
  50.                                 (setq entype_source (cdr (assoc 0 en_data)))
  51.                                 (if (or (setq txtst (cdr (assoc 7 en_data))) (= entype_source "TCH_DRAWINGNAME"))
  52.                                         (progn
  53.                                                 (redraw (car en) 3)
  54.                                                 (if (= entype_source "ATTDEF") ;如果是属性字,则取“标记”为源文字
  55.                                                         (setq source_text (cdr (assoc 2 en_data)))
  56.                                                         (setq source_text (cdr (assoc 1 en_data)))
  57.                                                 )
  58.                                         ))
  59.                         )
  60.     )
  61.     (if (and (= (setq en (nentsel (strcat "\n请选择源文字: 默认:" source_text))) nil) (= (getvar "ErrNo") 52))
  62.       (progn
  63.                                 (setvar "ErrNo" 0)
  64.                                 (setq txtst T)
  65.       )
  66.       (if en
  67.                                 (progn
  68.                                         (setq en_data (entget (car en)))
  69.                                         (setq entype_source (cdr (assoc 0 en_data)))
  70.                                         (if (or (setq txtst (cdr (assoc 7 en_data))) (= entype_source "TCH_DRAWINGNAME"))
  71.                                                 (progn
  72.                                                         (redraw (car en) 3)
  73.                                                         (if (= entype_source "ATTDEF") ;如果是属性字,则取“标记”为源文字
  74.                                                                 (setq source_text (cdr (assoc 2 en_data)))
  75.                                                                 (setq source_text (cdr (assoc 1 en_data)))
  76.                                                         )
  77.                                                 ))
  78.                                 )
  79.                                 (setvar "ErrNo" 52)
  80.                         )
  81.     )
  82.   )
  83.   (if (or txtst (= entype_source "TCH_DRAWINGNAME"))
  84.                 (progn
  85.                         (prompt "\n请选择要修改内容的文字:")
  86.                         (while (/= (getvar "ErrNo") 52)
  87.                                 (prompt (strcat "\n文字内容将被刷成:" source_text))
  88.                                 (if (and (setq ss (ssget ":S" '((0 . "*TEXT,TCH_DRAWINGNAME,TCH_ELEVATION,INSERT,ATTDEF,ATTRIB")))) source_text)
  89.                                         (progn
  90.                                                 (if (= (caar (setq ss_data (ssnamex ss 0))) 1)
  91.                                                         (progn                       ; 点选时
  92.                                                                 (setq ent (ssname ss 0)
  93.                                                                         pt (trans (cadr (last (car ss_data))) 0 1)
  94.                                                                         en1 (car (nentselp pt))
  95.                                                                         en1_data (entget en1)
  96.                                                                         entype (cdr (assoc 0 en1_data))
  97.                                                                         ob (vlax-ename->vla-object en1)
  98.                                                                 )
  99.                                                                 (wenzishua entype entype_source ob source_text en1 ent)
  100.                                                         )
  101.                                                         (progn                       ; 框选时
  102.                                                                 (setq i 0)
  103.                                                                 (repeat (sslength ss)
  104.                                                                         (setq en1 (ssname ss i)
  105.                                                                                 ent en1
  106.                                                                                 en1_data (entget en1)
  107.                                                                                 entype (cdr (assoc 0 en1_data))
  108.                                                                                 ob (vlax-ename->vla-object en1)
  109.                                                                         )
  110.                                                                         (wenzishua entype entype_source ob source_text en1 ent)
  111.                                                                         (setq i (1+ i))
  112.                                                                 )                               ; end repeat
  113.                                                         )
  114.                                                 )
  115.                                         )
  116.                                 )
  117.                         ); end while
  118.                 ))
  119.   (if en (redraw (car en) 4))
  120.   (setvar "ErrNo" 0)
  121.   (setvar "cmdecho" 1)
  122.   (princ)
  123. )

  124. ;文字刷子程序
  125. (defun wenzishua (entype entype_source ob source_text en1 ent)
  126.   ; cad多行文字
  127.   (if (= entype "MTEXT")
  128.     (progn
  129.       (vla-put-TextString ob source_text)
  130.       (entupd en1)
  131.       (entupd ent)
  132.     )
  133.   )
  134.   ;去掉多行文字无用格式符号
  135.   (if (= entype_source "MTEXT")
  136.     (setq source_text (mtext2text source_text))
  137.   )
  138.   ; cad单行文字
  139.   (if (= entype "TEXT")
  140.     (progn
  141.       (vla-put-TextString ob source_text)
  142.       (entupd en1)
  143.       (entupd ent)
  144.     )
  145.   )
  146.   ; 天正文字的内容格式刷
  147.   (if (or
  148.                                 (= entype "TCH_TEXT")
  149.                                 (= entype "TCH_ELEVATION")
  150.       )
  151.     (progn
  152.       (vlax-put-property ob 'Text source_text)
  153.       (entupd en1)
  154.       (entupd ent)
  155.     )
  156.   )   
  157.   ; 天正图名、标高的内容格式刷
  158.   (if (= entype "TCH_DRAWINGNAME")
  159.     (progn
  160.       (vlax-put-property ob 'NameText source_text)
  161.       (entupd en1)
  162.       (entupd ent)
  163.     )
  164.   )
  165.   ; 属性文字 只改"标记"
  166.   (if (= entype "ATTDEF")
  167.     (progn
  168.       (vla-put-TagString ob source_text);改标记
  169.       (entupd en1)
  170.       (entupd ent)
  171.     )
  172.   )
  173.   ; 块中属性文字 只改"默认"
  174.   (if (= entype "ATTRIB")
  175.     (progn
  176.       (vla-put-TextString ob source_text);改默认
  177.       (entupd en1)
  178.       (entupd ent)
  179.     )
  180.   )
  181. )

  182. ;提取多行文字,去除无用格式符号--来自明经
  183. (defun mtext2text(MTextString / regex s)
  184.   (setq regex(vlax-create-object "Vbscript.RegExp")) ;引用正则表达式控件
  185.   (vlax-put-property regex "IgnoreCase" 0) ;不忽略大小写
  186.   (vlax-put-property regex "Global" 1) ;匹配方式,全文字匹配
  187.   (setq s MTextString)
  188.         ;替换\\字符
  189.   (vlax-put-property regex "Pattern" "\\\\\\\")
  190.   (setq s(vlax-invoke-method  regex "Replace" s (chr 1)))
  191.         ;替换\{字符
  192.   (vlax-put-property regex "Pattern" "\\\\{")
  193.   (setq s(vlax-invoke-method  regex "Replace" s (chr 2)))
  194.         ;替换\}字符
  195.   (vlax-put-property regex "Pattern" "\\\\}")
  196.   (setq s(vlax-invoke-method  regex "Replace" s (chr 3)))
  197.         ;删除段落缩进格式
  198.   (vlax-put-property regex "Pattern" "\\\\pi(.[^;]*);")
  199.   (setq s(vlax-invoke-method  regex "Replace" s ""))
  200.         ;删除制表符格式
  201.   (vlax-put-property regex "Pattern" "\\\\pt(.[^;]*);")
  202.   (setq s(vlax-invoke-method  regex "Replace" s ""))
  203.         ;删除堆迭格式
  204.   (vlax-put-property regex "Pattern" "\\\\S(.[^;]*)(\\^|#|\\\\)(.[^;]*);")
  205.   (setq s(vlax-invoke-method  regex "Replace" s ""))
  206.         ;删除字体、颜色、字高、字距、倾斜、字宽、对齐格式
  207.   (vlax-put-property regex "Pattern" "(\\\\F|\\\\f|\\\\C|\\\\H|\\\\\T|\\\\Q|\\\\W|\\\\A)(.[^;]*);")
  208.   (setq s(vlax-invoke-method  regex "Replace" s ""))
  209.         ;删除下划线、删除线格式
  210.   (vlax-put-property regex "Pattern" "(\\\\L|\\\\O|\\\\l|\\\\o)")
  211.   (setq s(vlax-invoke-method  regex "Replace" s ""))
  212.         ;删除不间断空格格式
  213.   (vlax-put-property regex "Pattern" "\\\\~")
  214.   (setq s(vlax-invoke-method  regex "Replace" s ""))
  215.         ;删除换行符格式
  216.   (vlax-put-property regex "Pattern" "\\\\P")
  217.   (setq s(vlax-invoke-method  regex "Replace" s ""))
  218.         ;删除换行符格式(针对Shift+Enter格式)
  219.   (vlax-put-property regex "Pattern" "\n")
  220.   (setq s(vlax-invoke-method  regex "Replace" s ""))
  221.         ;删除{}
  222.   (vlax-put-property regex "Pattern" "({|})")
  223.   (setq s(vlax-invoke-method  regex "Replace" s ""))
  224.         
  225.         ;替换回\\,\{,\}字符
  226.   (vlax-put-property regex "Pattern" "\\x01")
  227.   (setq s(vlax-invoke-method  regex "Replace" s "\"))
  228.   (vlax-put-property regex "Pattern" "\\x02")
  229.   (setq s(vlax-invoke-method  regex "Replace" s "{"))
  230.   (vlax-put-property regex "Pattern" "\\x03")
  231.   (setq s(vlax-invoke-method  regex "Replace" s "}"))
  232.         
  233.   (vlax-release-object regex)
  234.   s
  235. )
[/code]


本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
发表于 2019-10-5 13:39 | 显示全部楼层
是的是的.我也想对某正下手. 想了很久了.
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2019-10-16 02:25 , Processed in 0.155325 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.3

© 2001-2013 Comsenz Inc.

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