明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 8385|回复: 59

文本超级编辑:支持标注、文字、块内文字修改版本

  [复制链接]
发表于 2023-1-19 09:34:51 | 显示全部楼层 |阅读模式
本帖最后由 jun353835273 于 2023-7-28 22:18 编辑

原贴地址http://bbs.mjtd.com/thread-187014-1-1.html

由于原贴天正单行文字的不支持,花了点时间更新此代码
目前天正的对象颜色及对象宽度(天正文字没有宽度信息)没有支持,其他的测试基本么有问题
主要修改;
1、天正不支持entmod更改组码,更新就卡死,需要用VLA的方法。
2、天正角度为度和cad文字修改时的弧度单位不一样。

            (Vlax-put obj_tch 'TextStyle  sty );改样式
            (Vlax-put obj_tch 'Height  hig )   ;改高度
            (Vlax-put obj_tch 'Layer  lay )    ;改图层
            (Vlax-put obj_tch 'Rotation  tch_ang ) ;改旋转方向
            ;acActiveViewport-仅重新生成活动视口,acAllViewports-重新生成文档上的所有视口。
            (vla-regen(vla-get-ActiveDocument (vlax-get-acad-object))AcAllViewPorts)
存在问题;
外部参照还有待完善,不过外部参照搞起来比较麻烦,比如修改文字高度,要修改原始参照文件的源文件才可以,希望我这是抛砖引玉,高人来不断完善。
  1. ;*文本超级编辑_增加天正单行文字命令FD
  2. ;;; 自定义UnDo范围
  3. ;;(princ "\n修改文字已加载,启动命令ed.")
  4. ;;原作者不详
  5. ;;2023年1月19日更改by 半途中
  6. (defun EF:UNDOBegin ()
  7.   (setvar "CMDECHO" 0)
  8.   (command "_.undo" "_group")
  9.   (princ)
  10. )
  11. ;;; end defun
  12. (defun EF:UNDOEnd ()
  13.   (setvar "CMDECHO" 0)
  14.   (command "_.undo" "_end")
  15.   (princ)
  16. )
  17. ;;; end defun
  18. (defun C:fd (/      dcl_id1    oba   ob1  obn    obt    ptn
  19.        otxt   txt     sty    styno   lay  cyn    layno  hig
  20.        wid    ang     col    cnu   etlst  style  layer  obj_tch  tch_ang
  21.       )
  22.   (graphscr)
  23.   (EF:UNDOBegin)
  24.   (setq olderr *error*)
  25.   (defun *error* (msg)
  26.     (princ "\n*ERROR*...")
  27.     (princ msg)
  28.     (princ)
  29.   )          ; end defun error.
  30.   (defun set_color (conm / costr)
  31.     (defun map_color (ckey mno)
  32.       (start_image ckey)
  33.       (fill_image 0 0 (DimX_tile ckey) (DimY_tile ckey) mno)
  34.       (end_image)
  35.     )          ; end defun
  36.     (cond
  37.       ((= 0 conm)
  38.        (setq costr "Byblock")
  39.       )
  40.       ((= 1 conm)
  41.        (setq costr "Red")
  42.       )
  43.       ((= 2 conm)
  44.        (setq costr "Yellow")
  45.       )
  46.       ((= 3 conm)
  47.        (setq costr "Green")
  48.       )
  49.       ((= 4 conm)
  50.        (setq costr "Cyan")
  51.       )
  52.       ((= 5 conm)
  53.        (setq costr "Bule")
  54.       )
  55.       ((= 6 conm)
  56.        (setq costr "Magenta")
  57.       )
  58.       ((= 7 conm)
  59.        (setq costr "color")
  60.       )
  61.       ((= 256 conm)
  62.        (setq costr "Bylayer")
  63.       )
  64.       (t
  65.        (setq costr "")
  66.       )
  67.     )          ; end cond
  68.     (cond
  69.       ((= 0 col)
  70.        (map_color "col" 7)
  71.       )
  72.       ((= 256 col)
  73.        (map_color "col" (cdr (assoc 62 (tblsearch "layer" lay))))
  74.       )
  75.       (t
  76.        (map_color "col" conm)
  77.       )
  78.     )          ; end cond
  79.     (if  (= 256 conm)
  80.       (set_tile  "cnu"
  81.     (strcat  "<"
  82.       (itoa (cdr (assoc 62
  83.             (tblsearch "layer"
  84.                  lay
  85.             )
  86.            )
  87.             )
  88.       )
  89.       ">"
  90.       costr
  91.     )
  92.       )
  93.       (set_tile "cnu" (strcat "<" (itoa conm) ">" costr))
  94.     )          ; end if


  95.   )          ; end set_color
  96.   (defun map_keylist (key keylst)  ; set popuplist
  97.     (start_list key)
  98.     (mapcar
  99.       'add_list
  100.       keylst
  101.     )
  102.     (end_list)
  103.   )          ; end map
  104.   (defun layer_get_all (/ lay layer layname)
  105.     (setq layer  nil      ; All layer
  106.     lay  (tblnext "LAYER" T)
  107.     )
  108.     (while (/= lay nil)
  109.       (setq layname (cdr (assoc 2 lay))
  110.       layer   (cons layname layer)
  111.       )
  112.       (setq lay (tblnext "LAYER"))
  113.     )
  114.     (setq layer (ACAD_Strlsort layer))
  115.     layer        ; all layer.


  116.   )          ; end defun
  117.   (defun style_get_all (/ sty style sty_list)
  118.     (setq sty_list nil
  119.     sty     (tblnext "style" t)
  120.     )
  121.     (setq style (cdr (assoc 2 sty)))
  122.     (while style
  123.       (if (/= "" style)
  124.   (setq sty_list (append
  125.        sty_list
  126.        (list style)
  127.            )
  128.   )
  129.       )
  130.       (setq sty (tblnext "style"))
  131.       (setq style (cdr (assoc 2 sty)))
  132.     )          ; end while]
  133.     (setq sty_list (ACAD_Strlsort sty_list))
  134.     sty_list
  135.   )          ; end defun
  136.   (defun set_error (str)
  137.     (set_tile "error" str)
  138.   )          ; end defun
  139.   (defun sub_mtext (color entlist / ei newlist)
  140.     (setq ei 0
  141.     newlist nil
  142.     )
  143.     (while (< ei (length entlist))
  144.       (setq newlist (cons (nth ei entlist) newlist))
  145.       (if (= 8 (car (nth ei entlist)))
  146.   (setq newlist (cons (cons 62 color) newlist))
  147.       )          ; end if
  148.       (setq ei (1+ ei))
  149.     )          ; end while
  150.     (reverse newlist)
  151.   )          ; end defun
  152.   (setq ob1 (entsel "\n选择要修改的任何文本:"))
  153.   (SETQ  obn (car ob1)
  154.   ptn (car (cdr ob1))
  155.   )
  156.   (setq obt (car (nentselp ptn)))
  157.   (setq oba (cdr (assoc 0 (entget obt))))
  158.   (if (or
  159.   (= oba "TEXT")
  160.   (= oba "MTEXT")
  161.   (= oba "ATTRIB")
  162.   (= oba "TCH_TEXT")
  163.       )
  164.     (setq otxt (cdr (assoc 1 (entget obt))))
  165.   )          ; end if
  166.   (if (= oba "ATTDEF")
  167.     (setq otxt (cdr (assoc 2 (entget obt))))
  168.   )          ; end if
  169.   (if otxt
  170.     (progn
  171.       (setq sty  (cdr (assoc 7 (entget obt)))
  172.       lay  (cdr (assoc 8 (entget obt)))
  173.       hig  (cdr (assoc 40 (entget obt)))
  174.       wid  (cdr (assoc 41 (entget obt)))
  175.       ang  (cdr (assoc 50 (entget obt)))
  176.       )          ; end setq
  177.       (if (or
  178.       (= oba "TEXT")
  179.       (= oba "MTEXT")
  180.       (= oba "ATTRIB")
  181.       (= oba "TCH_TEXT")
  182.     )
  183.   (setq col (cdr (assoc 62 (entget obt))))
  184.   (setq col (cdr (assoc 62 (entget obn))))
  185.       )  ; end if
  186.       (setq tch_ang ang)
  187.       ;(alert (rtos tch_ang 2 2 ))
  188.       (setq ang (* 180 (/ ang pi)))
  189.       (if (null col)
  190.   (progn
  191.     (setq cyn 0)
  192.     (setq col 256)
  193.   )
  194.   (setq cyn 1)
  195.       )
  196.       (setq style (style_get_all))
  197.       (setq layer (layer_get_all))
  198.       (setq styno (- (length style) (length (member sty style))))
  199.       (setq layno (- (length layer) (length (member lay layer))))

  200.       (setq dclname
  201.        (cond
  202.          ((setq tempname (vl-filename-mktemp "tt-dcl-tmp.dcl")
  203.           filen    (open tempname "w")
  204.     )
  205.     (foreach stream
  206.         '("\n"
  207.           "文字修改:dialog {\n"
  208.           "  label = "文字编辑...";\n"
  209.           "  : boxed_radio_column {\n"
  210.           "    label = "超级文字编辑...";\n"
  211.           "    : edit_box {\n"
  212.           "      label= "文字:";\n"
  213.           "      key = "text";\n"
  214.           "      edit_width = 50;\n"
  215.           "      allow_accept = true;\n"
  216.           "    }\n"
  217.           "    : row {\n"
  218.           "      : popup_list {\n"
  219.           "        label="样式";\n"
  220.           "        key = "sty";\n"
  221.           "        edit_width = 13;\n"
  222.           "        fixed_width = true;\n"
  223.           "      }\n"
  224.           "      : edit_box {\n"
  225.           "        label="高度";\n"
  226.           "        key = "hig";\n"
  227.           "        edit_width = 7;\n"
  228.           "        fixed_width = true;\n"
  229.           "      }\n"
  230.           "      : edit_box {\n"
  231.           "        label="宽度";\n"
  232.           "        key = "wid";\n"
  233.           "        edit_width = 7;\n"
  234.           "        fixed_width = true;\n"
  235.           "      }\n"
  236.           "    }\n"
  237.           "    : row {\n"
  238.           "      : popup_list {\n"
  239.           "        label="图层";\n"
  240.           "        key = "lay";\n"
  241.           "        edit_width = 13;\n"
  242.           "        fixed_width = true;\n"
  243.           "      }\n"
  244.           "      : image_button {\n"
  245.           "        key = "col";\n"
  246.           "        width= 4;\n"
  247.           "        aspect_ratio = 0.75;\n"
  248.           "        fixed_width = true;\n"
  249.           "      }\n"
  250.           "      : text_part {\n"
  251.           "        key = "cnu";\n"
  252.           "        width= 12;\n"
  253.           "        fixed_width = true;\n"
  254.           "      }\n"
  255.           "      : edit_box {\n"
  256.           "        label="角度";\n"
  257.           "        key = "ang";\n"
  258.           "        edit_width = 7;\n"
  259.           "        fixed_width = true;\n"
  260.           "      }\n"
  261.           "    }\n"
  262.           "    spacer_1;\n"
  263.           "  }\n"
  264.           "  : row {\n"
  265.           "    alignment = right;\n"
  266.           "    : spacer {\n"
  267.           "      width = 1;\n"
  268.           "      fixed_width = true;\n"
  269.           "      }\n"
  270.           "    ok_cancel;\n"
  271.           "  }\n"
  272.           "  errtile;\n"
  273.           "}\n"
  274.          )
  275.       (princ stream filen)
  276.     )
  277.     (close filen)
  278.     tempname
  279.          )
  280.        )
  281.       )

  282.       (setq dcl_id1 (load_dialog dclname))
  283.       (if (not (new_dialog "文字修改" dcl_id1))
  284.   (exit)
  285.       )
  286.       (set_color col)
  287.       (set_tile "text" otxt)
  288.       (set_tile "hig" (rtos hig 2 2))
  289.           ;(set_tile "wid" (rtos wid 2 2))
  290.       (if (not wid)
  291.   (setq wid 1)
  292.       )
  293.       (set_tile "wid" (rtos wid 2 2))
  294.       (set_tile "ang" (rtos ang 2 2))
  295.       (mode_tile "text" 2)
  296.       (map_keylist "sty" style)
  297.       (set_tile "sty" (itoa styno))
  298.       (map_keylist "lay" layer)
  299.       (set_tile "lay" (itoa layno))
  300.       (action_tile "text" "(setq txt $value)")
  301.       (action_tile "sty" "(setq styno (atoi $value))")
  302.       (action_tile
  303.   "hig"
  304.   "(setq hig (distof $value))(if (>= 0 hig)(progn (mode_tile "hig" 3)(mode_tile "hig" 2)(set_error "Input error ! "))(set_error ""))"
  305.       )
  306.       (action_tile
  307.   "wid"
  308.   "(setq wid (distof $value))(if (>= 0 wid)(progn (mode_tile "wid" 3)(mode_tile "wid" 2)(set_error "Input error ! "))(set_error ""))"
  309.       )
  310.       (action_tile "lay" "(setq layno (atoi $value))")
  311.       (action_tile
  312.   "col"
  313.   "(if (setq cnu (ACAD_ColorDlg col))(progn (setq col cnu)(set_color col)))"
  314.       )
  315.       (action_tile "ang" "(setq ang (distof $value))")
  316.       (action_tile "accept" "(done_dialog 1)")
  317.       (action_tile "cancel" "(done_dialog 0)")

  318.       (if (= 1 (start_dialog))
  319.   (if txt
  320.     (progn
  321.       ;(setq aabb txt)
  322.       ;hig 字体高度
  323.       ;COL  颜色
  324.       (setq sty (nth styno style));字体样式
  325.       (setq lay (nth layno layer));图层
  326.       (setq tch_ang ang)          ;天正为度
  327.       (setq ang (* (/ ang 180) pi));角度  弧度
  328.       (setq etlst (entget obt))
  329.       (if  (= oba "ATTDEF")
  330.         (setq etlst (subst
  331.           (cons 2 txt)
  332.           (assoc 2 etlst)
  333.           etlst
  334.         )
  335.         )
  336.         (setq etlst (subst
  337.           (cons 1 txt)
  338.           (assoc 1 etlst)
  339.           etlst
  340.         )
  341.         )
  342.       )        ; end if
  343.       ;TCH_TEXT  天正文字
  344.       (if  (= oba "TCH_TEXT")
  345.         (progn
  346.                    (and (setq obj_tch (vlax-ename->vla-object obt))
  347.        (vlax-put-property obj_tch 'TEXT txt)
  348.               )
  349.             (Vlax-put obj_tch 'TextStyle  sty );改样式
  350.             (Vlax-put obj_tch 'Height  hig )   ;改高度
  351.             (Vlax-put obj_tch 'Layer  lay )    ;改图层
  352.       (Vlax-put obj_tch 'Rotation  tch_ang ) ;改旋转方向
  353.       ;acActiveViewport-仅重新生成活动视口,acAllViewports-重新生成文档上的所有视口。
  354.             (vla-regen(vla-get-ActiveDocument (vlax-get-acad-object))AcAllViewPorts)
  355.          )
  356.         (progn
  357.       (setq etlst  (subst
  358.         (cons 7 sty)
  359.         (assoc 7 etlst)
  360.         etlst
  361.       )
  362.       )
  363.       (setq etlst  (subst
  364.         (cons 40 hig)
  365.         (assoc 40 etlst)
  366.         etlst
  367.       )
  368.       )
  369.       (setq etlst  (subst
  370.         (cons 41 wid)
  371.         (assoc 41 etlst)
  372.         etlst
  373.       )
  374.       )
  375.       (setq etlst  (subst
  376.         (cons 50 ang)
  377.         (assoc 50 etlst)
  378.         etlst
  379.       )
  380.       )
  381.       (setq etlst  (subst
  382.         (cons 8 lay)
  383.         (assoc 8 etlst)
  384.         etlst
  385.       )
  386.       )
  387.       (if  (= 1 cyn)
  388.         (setq etlst (subst
  389.           (cons 62 col)
  390.           (assoc 62 etlst)
  391.           etlst
  392.         )
  393.         )
  394.         (if (= "MTEXT" oba)
  395.     (setq etlst (sub_mtext col etlst))
  396.     (setq etlst (cons (cons 62 col) etlst))
  397.         )        ; end if
  398.       )        ; end if
  399.       (entmod etlst)
  400.       (entupd obt)
  401.       (entupd obn)
  402.       )
  403.       )        ; end TCH_TEXT
  404.     )
  405.   )        ; end if
  406.       )          ; end if
  407.       (if (= 11 (start_dialog))
  408.   (Command "_help")
  409.       )
  410.     )          ; end progn
  411.   )          ; end if
  412.   (setq *error* olderr)
  413.   (EF:UNDOEnd)
  414.   (princ)
  415.   (unload_dialog dcl_id1)
  416.   (vl-file-delete dclname)
  417. )
  418. ;;; end defun




本帖子中包含更多资源

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

x

评分

参与人数 4明经币 +4 收起 理由
muwind + 1
USER2128 + 1 很给力!
yanchao316 + 1 很给力!
口风琴 + 1 很给力!

查看全部评分

发表于 2023-7-21 10:52:44 | 显示全部楼层

对不起哈,我不太会。我测试了两台CAD2022 2024 天正T20V9的情况下。成功的概率很小。都是 清一色的提示:选择要修改的任何文本:T

等我再学学Lisp再调试一下。大佬您的这个思路和代码真的非常好!
 楼主| 发表于 2023-7-4 22:10:22 | 显示全部楼层
photo_cup 发表于 2023-7-4 19:45
可以麻烦帮改下么,谢谢

标注移动了变回原值的你提供个测试图,有空我看看。
关于框选实现起来有难度这个是通过entsel 单个选择的,框选整个程序结构都要改变。
发表于 2023-10-26 09:14:51 | 显示全部楼层
我不太会。我测试了两台CAD2022 2024 天正T20V9的情况下。成功的概率很小。都是 清一色的提示:选择要修改的任何文本:T

等我再学学Lisp再调试一下。大佬您的这个思路和代码真的非常好!
发表于 2023-1-19 10:31:32 | 显示全部楼层
感谢楼主共享资源!
发表于 2023-1-19 12:40:44 | 显示全部楼层
感谢楼主分享!
发表于 2023-1-19 22:24:00 | 显示全部楼层
谢谢楼主分享
发表于 2023-1-22 09:13:16 | 显示全部楼层
谢楼主共享好程序,回复表示感谢
发表于 2023-2-4 14:27:02 | 显示全部楼层
超级牛逼的程序,谢谢楼主分享啊。正需要的。
发表于 2023-2-4 17:05:39 | 显示全部楼层
感谢楼主分享!
发表于 2023-2-12 14:28:13 | 显示全部楼层
多谢楼主分享。要是不需要面板待修改的文字和用来修改的内容能在命令行输入就更好了
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-11-24 23:59 , Processed in 0.175700 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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