找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 6006|回复: 41

[他山之石] 从格式化的MTEXT获得真实的文本的代码

[复制链接]

已领礼包: 20个

财富等级: 恭喜发财

发表于 2013-5-30 12:08:19 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

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

×


转自LEE-MAC

0.jpg

  1. ;;------------------=={ Get True Content }==------------------;;
  2. ;;                                                            ;;
  3. ;;  Returns the unformatted string associated with the        ;;
  4. ;;  supplied entity, in formats compatible with Text & MText  ;;
  5. ;;  objects.                                                  ;;
  6. ;;                                                            ;;
  7. ;;  The arguments *dtextstring & *mtextstring should be       ;;
  8. ;;  supplied with quoted symbols (other than those symbols    ;;
  9. ;;  used by the arguments themselves). The unformatted        ;;
  10. ;;  strings suitable for Text & MText objects will henceforth ;;
  11. ;;  be bound to the supplied symbol arguments respectively.   ;;
  12. ;;                                                            ;;
  13. ;;  Note that it is the caller's responsibility to create and ;;
  14. ;;  release the RegularExpressions (RegExp) object. This      ;;
  15. ;;  object may be created using the                           ;;
  16. ;;  Programmatic Identifier: "VBScript.RegExp".               ;;
  17. ;;------------------------------------------------------------;;
  18. ;;  Author: Lee Mac, Copyright ?2010 - www.lee-mac.com       ;;
  19. ;;------------------------------------------------------------;;
  20. ;;  Arguments:                                                ;;
  21. ;;  RegExp       - RegularExpressions (RegExp) Object         ;;
  22. ;;  entity       - Ename whose text content is to be returned ;;
  23. ;;  *dtextstring - (output) Unformatted string compatible     ;;
  24. ;;                 with Text entities                         ;;
  25. ;;  *mtextstring - (output) Unformatted string compatible     ;;
  26. ;;                 with MText entities                        ;;
  27. ;;------------------------------------------------------------;;
  28. ;;  Returns:    This function always returns nil              ;;
  29. ;;------------------------------------------------------------;;

  30. (defun LM:GetTrueContent ( RegExp entity *dtextstring *mtextstring / _Replace _AllowsFormatting _GetTextString )

  31.   (defun _Replace ( new old string )
  32.     (vlax-put-property RegExp 'pattern old) (vlax-invoke RegExp 'replace string new)
  33.   )

  34.   (defun _AllowsFormatting ( entity / object )   
  35.     (or (wcmatch (cdr (assoc 0 (entget entity))) "MTEXT,MULTILEADER")      
  36.       (and
  37.         (eq "ATTRIB" (cdr (assoc 0 (entget entity))))
  38.         (vlax-property-available-p (setq object (vlax-ename->vla-object entity)) 'MTextAttribute)
  39.         (eq :vlax-true (vla-get-MTextAttribute object))
  40.       )
  41.     )
  42.   )

  43.   (defun _GetTextString ( entity )
  44.     (
  45.       (lambda ( entity / _type elist )
  46.         (cond
  47.           ( (wcmatch (setq _type (cdr (assoc 0 (setq elist (entget entity))))) "TEXT,*DIMENSION")

  48.             (cdr (assoc 1 (reverse elist)))
  49.           )
  50.           ( (eq "MULTILEADER" _type)

  51.             (cdr (assoc 304 elist))
  52.           )
  53.           ( (wcmatch _type "ATTRIB,MTEXT")

  54.             (
  55.               (lambda ( string )
  56.                 (mapcar
  57.                   (function
  58.                     (lambda ( pair )
  59.                       (if (member (car pair) '(1 3))
  60.                         (setq string (strcat string (cdr pair)))
  61.                       )
  62.                     )
  63.                   )
  64.                   elist
  65.                 )
  66.                 string
  67.               )
  68.               ""
  69.             )
  70.           )
  71.         )
  72.       )
  73.       (if (eq 'VLA-OBJECT (type entity))
  74.         (vlax-vla-object->ename entity)
  75.         entity
  76.       )
  77.     )
  78.   )

  79.   (
  80.     (lambda ( string )
  81.       (if string
  82.         (progn
  83.           (mapcar
  84.             (function
  85.               (lambda ( x ) (vlax-put-property RegExp (car x) (cdr x)))
  86.             )
  87.             (list (cons 'global actrue) (cons 'ignorecase acfalse) (cons 'multiline actrue))
  88.           )
  89.           (if (_AllowsFormatting entity)
  90.             (mapcar
  91.               (function
  92.                 (lambda ( x ) (setq string (_Replace (car x) (cdr x) string)))
  93.               )
  94.              '(
  95.                 ("?       . "\\\\\\\\")
  96.                 (" "       . "\\\\P|\\n|\\t")
  97.                 ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
  98.                 ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
  99.                 ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
  100.                 ("$1"      . "[\\\\]({)|{")
  101.               )
  102.             )
  103.             (setq string (_Replace "" "%%[OoUu]" (_Replace "? "\\\\" string)))
  104.           )
  105.           (set *mtextstring (_Replace "\\\\" "? (_Replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" string)))
  106.           (set *dtextstring (_Replace "\\"   "? string))
  107.         )
  108.       )
  109.     )
  110.     (_GetTextString entity)
  111.   )
  112.   nil
  113. )


  114. (defun c:test ( / *error* _AllowsFormatting RegExp src des text mtext )
  115.   (vl-load-com)
  116.   ;; ?Lee Mac 2010

  117.   (defun *error* ( msg )
  118.     (if RegExp (vlax-release-object RegExp))
  119.     (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
  120.         (princ (strcat "\n** Error: " msg " **")))
  121.     (princ)
  122.   )

  123.   (defun _AllowsFormatting ( entity / object )   
  124.     (or (wcmatch (cdr (assoc 0 (entget entity))) "MTEXT,MULTILEADER")      
  125.       (and
  126.         (eq "ATTRIB" (cdr (assoc 0 (entget entity))))
  127.         (vlax-property-available-p (setq object (vlax-ename->vla-object entity)) 'MTextAttribute)
  128.         (eq :vlax-true (vla-get-MTextAttribute object))
  129.       )
  130.     )
  131.   )

  132.   (while (and (setq src (car (nentsel "\nSelect Source Object: ")))
  133.               (not (wcmatch (cdr (assoc 0 (entget src))) "*TEXT,ATTRIB,MULTILEADER")))
  134.     (princ "\n** Source Object must Contain Text **")
  135.   )

  136.   (while (and (setq des (car (nentsel "\nSelect Destination Object: ")))
  137.               (not (wcmatch (cdr (assoc 0 (entget des))) "*TEXT,ATTRIB,MULTILEADER")))
  138.     (princ "\n** Destination Object must Contain Text **")
  139.   )

  140.   (if (and src des)
  141.     (progn
  142.       (setq RegExp (vlax-get-or-create-object "VBScript.RegExp"))      
  143.       (LM:GetTrueContent RegExp src 'text 'mtext)

  144.       (vla-put-TextString (vlax-ename->vla-object des)
  145.         (if (_AllowsFormatting des)
  146.           mtext
  147.           text
  148.         )
  149.       )

  150.       (vlax-release-object RegExp)
  151.     )
  152.   )

  153.   (princ)
  154. )



评分

参与人数 2D豆 +7 收起 理由
/db_自贡黄明儒_ + 2
牢固 + 5 很给力!经验;技术要点;资料分享奖!

查看全部评分

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
发表于 2013-5-30 12:43:30 来自手机 | 显示全部楼层
explode后就是text了来自: Android客户端

点评

炸开后,换行的文字就一个文字,变成两个文字了  详情 回复 发表于 2013-6-9 15:28

评分

参与人数 1D豆 +5 收起 理由
wowan1314 + 5 太暴力了!不过却也简单直接

查看全部评分

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2013-5-30 13:12:31 | 显示全部楼层
LEE-MAC最擅长的就是:
大量使用mapcar. lambda。一个个一层层的。
看他的代码好费事!

点评

是啊。太难懂  详情 回复 发表于 2013-6-9 15:33
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 51个

财富等级: 招财进宝

发表于 2013-5-30 16:35:14 | 显示全部楼层
wowan1314 发表于 2013-5-30 13:12
LEE-MAC最擅长的就是:
大量使用mapcar. lambda。一个个一层层的。
看他的代码好费事!

这不正是你这几天在追求的嘛。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2013-6-9 15:28:16 | 显示全部楼层


炸开后,换行的文字就一个文字,变成两个或多个文字了
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2013-6-9 15:33:14 | 显示全部楼层
wowan1314 发表于 2013-5-30 13:12
LEE-MAC最擅长的就是:
大量使用mapcar. lambda。一个个一层层的。
看他的代码好费事!

是啊。太难懂
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 3915个

财富等级: 富可敌国

发表于 2013-6-9 18:23:42 | 显示全部楼层
下来学习学习!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 6468个

财富等级: 富甲天下

发表于 2013-6-10 23:13:16 | 显示全部楼层
大师级的作品,一般都是很难看懂的。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

zjhlxxl 该用户已被删除
发表于 2015-10-15 21:04:56 | 显示全部楼层
提示: 作者被禁止或删除 内容自动屏蔽
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 604个

财富等级: 财运亨通

发表于 2016-11-14 16:51:26 | 显示全部楼层
有没有最新版,为什么我运行失败呢?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 13个

财富等级: 恭喜发财

发表于 2016-11-14 17:25:20 | 显示全部楼层

其实就是正则表达式替换,你把里面正则匹配的拿出来,放入 XD::String:RegexpR 一样的,不用这么多代码。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 604个

财富等级: 财运亨通

发表于 2016-11-15 11:08:10 | 显示全部楼层

不错的主意!!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 40个

财富等级: 招财进宝

发表于 2016-11-15 12:09:46 | 显示全部楼层

弄好后贴上来啊,老黄
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 604个

财富等级: 财运亨通

发表于 2016-11-16 16:12:40 | 显示全部楼层
本帖最后由 /db_自贡黄明儒_ 于 2016-11-16 16:42 编辑
Command: (XD::String:Replace "A" "ddddA" "?" "")=>"dddd?"正确

(XD::String:Replace "?" "Autodesk \\{??OAutoCAD??o\\}" "\\\\" "")  错误


没法成功呀,找不出问题所在,您对正则熟习,还是你来一个吧
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 604个

财富等级: 财运亨通

发表于 2016-11-17 15:41:57 | 显示全部楼层

现在搞好了,轮到您来优化了
;;用正则法去除控制符,返回去除后的文字
(defun C:W2 (/                     MTEXTOBJLST     ACADVER             FORMATS
             LOCKEDCELLFLAG  MLDROBJLST             DIMOBJLST             TABLEOBJLST
             LAYERS             MATTOBJLST             OBJ             OBJNAME
             STR             CNT             SPINFLAG             LOCKEDCELLFLAG
             SPINBAR             FORMATSTOLIST   STRIPFORMAT     STRIPCOLUMN
             STRIPMASK             STRIPFIELD             STRIPTABLEFIELDS
             STRIPTABLE             STRIPMLEADER    STRIPMATTRIBUTE ROWSCOLUMNS
             CELLFIELDOWNER  SYMBOLSTRING    GETFIELDS             ISANNOTATIVE
             GETANNOSCALES
            )

  (defun FORMATSTOLIST (ARG / LST)
    (cond
      ((= (TYPE ARG) 'LIST) (MAPCAR 'STRCASE ARG))
      ((= (TYPE ARG) 'STR)
       (while (NOT (EQ "" (SUBSTR ARG 1)))
         (if (EQ "^" (SUBSTR ARG 1 1))
           (progn (setq LST (CONS (STRCAT "^" (SUBSTR ARG 2 1)) LST))
                  (setq ARG (SUBSTR ARG 3))
           )
           (progn (setq LST (CONS (SUBSTR ARG 1 1) LST))
                  (setq ARG (SUBSTR ARG 2))
           )
         )
       )
       (MAPCAR 'STRCASE (REVERSE LST))
      )
    )
  )

  (defun STRIPFORMAT (STR         FORMATS    /               TEXT          SLASHFLAG  LBRACE
                      RBRACE         RE:EXECUTE ALIGNMENT  TAB          COLOR             FONT
                      HEIGHT         LINEFEED   OVERLINE   PARAGRAPH  OBLIQUE    STACKING
                      TRACKING         UNDERLINE  WIDTH      BRACES          HARDSPACE
                     )
    (setq FORMATS (FORMATSTOLIST FORMATS))
    (or *xxvb**p (setq *xxvb**p (vlax-create-object "VBScript.RegExp")))

    (defun RE:EXECUTE (PAT STRING / RESULT MATCH IDX LST)
      (setq RESULT (vlax-invoke *xxvb**p 'EXECUTE STRING))
      (vlax-for        X RESULT
        (setq MATCH (vlax-get X 'VALUE))
        (setq IDX (vlax-get X 'FIRSTINDEX))
        (setq LST (CONS (LIST MATCH IDX) LST))
      )
      LST
    )

    (setq STR (XD::String:Replace "\\n" STR "\\P" ""))

    (defun ALIGNMENT (STR) (XD::String:Replace "\\\\A[012];" STR "" ""))

    (defun TAB (STR / LST ORIGSTR TEMPSTR)
      (setq LST (RE:EXECUTE "\\\\P\\t|[0-9]+;\\t" STR))
      (foreach X LST
        (setq ORIGSTR (CAR X))
        (setq TEMPSTR (XD::String:Replace "\\t" ORIGSTR "" ""))
        (setq STR (VL-STRING-SUBST TEMPSTR ORIGSTR STR))
      )
      (XD::String:Replace "\\t" STR " " "")
    )

    (defun COLOR (STR)
      (XD::String:Replace "\\\\[Cc][0-9]?[.]?[0-9]+;" STR "" "")
    )

    (defun FONT (STR) (XD::String:Replace "\\\\[Ff].*?;" STR "" ""))

    (defun HEIGHT (STR)
      (XD::String:Replace "\\\\H[0-9]?[.]?[0-9]+x;" STR "" "")
    )

    (defun LINEFEED (STR / TESTSTR)
      (setq TESTSTR (ALIGNMENT STR))
      (setq TESTSTR (COLOR TESTSTR))
      (setq TESTSTR (FONT TESTSTR))
      (setq TESTSTR (HEIGHT TESTSTR))
      (setq TESTSTR (OVERLINE TESTSTR))
      (setq TESTSTR (PARAGRAPH TESTSTR))
      (setq TESTSTR (OBLIQUE TESTSTR))
      (setq TESTSTR (TRACKING TESTSTR))
      (setq TESTSTR (UNDERLINE TESTSTR))
      (setq TESTSTR (WIDTH TESTSTR))
      (setq TESTSTR (BRACES TESTSTR))
      (while (EQ "\\P" (SUBSTR TESTSTR 1 2))
        (setq TESTSTR (SUBSTR TESTSTR 3))
        (setq STR (VL-STRING-SUBST "" "\\P" STR))
      )
      (XD::String:Replace " \\\\P|\\\\P |\\\\P" STR " " "")
    )

    (defun OVERLINE (STR) (XD::String:Replace "\\\\[Oo]" STR "" ""))

    (defun PARAGRAPH (STR) (XD::String:Replace "\\\\p.*?;" STR "" ""))

    (defun OBLIQUE (STR)
      (XD::String:Replace "\\\\Q[-]?[0-9]*?[.]?[0-9]+;" STR "" "")
    )

    (defun STACKING
                    (STR / LST TEMPSTR POS ORIGSTR TESTSTR TESTPOS NUMCHECK)
      (setq LST (RE:EXECUTE "\\\\S(.*?)(\\;)" STR))
      (foreach X LST
        (setq TEMPSTR (CAR X))
        (setq POS (CADR X))
        (setq ORIGSTR TEMPSTR)
        (setq TESTSTR (ALIGNMENT STR))
        (setq TESTSTR (COLOR TESTSTR))
        (setq TESTSTR (FONT TESTSTR))
        (setq TESTSTR (HEIGHT TESTSTR))
        (setq TESTSTR (LINEFEED TESTSTR))
        (setq TESTSTR (OVERLINE TESTSTR))
        (setq TESTSTR (PARAGRAPH TESTSTR))
        (setq TESTSTR (OBLIQUE TESTSTR))
        (setq TESTSTR (TRACKING TESTSTR))
        (setq TESTSTR (UNDERLINE TESTSTR))
        (setq TESTSTR (WIDTH TESTSTR))
        (setq TESTSTR (BRACES TESTSTR))
        (setq TESTSTR (XD::String:Replace "[{]" TESTSTR "" ""))
        (setq TESTPOS (CADAR (RE:EXECUTE "\\\\S(.*?)(\\;)" TESTSTR)))
        (if (/= 0 TESTPOS)
          (setq NUMCHECK (SUBSTR TESTSTR TESTPOS 1))
        )
        (if (and NUMCHECK (<= 48 (ASCII NUMCHECK) 57))
          (setq TEMPSTR (XD::String:Replace "\\\\S" TEMPSTR " " ""))
          (setq TEMPSTR (XD::String:Replace "\\\\S" TEMPSTR "" ""))
        )
        (setq TEMPSTR (XD::String:Replace "[#]" TEMPSTR "/" ""))
        (setq TEMPSTR (XD::String:Replace "[;]" TEMPSTR "" ""))
        (setq TEMPSTR (XD::String:Replace "\\\\A(.*?)[;]" TEMPSTR "" ""))
        (setq TEMPSTR (XD::String:Replace "\\^" TEMPSTR "" ""))
        (setq STR (VL-STRING-SUBST TEMPSTR ORIGSTR STR POS))
      )
      STR
    )

    (defun TRACKING (STR)
      (XD::String:Replace "\\\\T[0-9]?[.]?[0-9]+;" STR "" "")
    )

    (defun UNDERLINE (STR) (XD::String:Replace "\\\\[Ll]" STR "" ""))

    (defun WIDTH (STR)
      (XD::String:Replace "\\\\W[0-9]?[.]?[0-9]+;" STR "" "")
    )

    (defun HARDSPACE (STR)
      (XD::String:Replace "{\\\\[Ff](.*?)\\\\~}|\\\\~" STR " " "")
    )

    (defun BRACES (STR / LST ORIGSTR TEMPSTR LEN TESTSTR)
      (setq LST (RE:EXECUTE "{[^\\\\]+}" STR))
      (foreach X LST
        (setq ORIGSTR (CAR X))
        (setq TEMPSTR (XD::String:Replace "[{}]" ORIGSTR "" ""))
        (setq STR (VL-STRING-SUBST TEMPSTR ORIGSTR STR))
      )
      (setq LEN (STRLEN STR))
      (if (and (= 123 (ASCII (SUBSTR STR 1 1)))
               (= 125 (ASCII (SUBSTR STR LEN 1)))
               (setq TESTSTR (SUBSTR STR 2))
               (setq TESTSTR (SUBSTR TESTSTR 1 (1- (STRLEN TESTSTR))))
               (NOT (VL-STRING-SEARCH "{" TESTSTR))
               (NOT (VL-STRING-SEARCH "}" TESTSTR))
          )
        (setq STR TESTSTR)
      )
      STR
    )

    (setq SLASHFLAG
           (STRCAT "<" (SUBSTR (RTOS (GETVAR "CDATE") 2 8) 14) ">")
    )
    (setq TEXT (XD::String:Replace "\\\\\\\\" STR SLASHFLAG ""))
    (setq
      LBRACE (STRCAT "<L" (SUBSTR (RTOS (GETVAR "CDATE") 2 8) 14) ">")
    )
    (setq TEXT (XD::String:Replace "\\\\{" TEXT LBRACE ""))
    (setq
      RBRACE (STRCAT "<" (SUBSTR (RTOS (GETVAR "CDATE") 2 8) 14) "R>")
    )
    (setq TEXT (XD::String:Replace "\\\\}" TEXT RBRACE ""))
    (if        (or (VL-POSITION "A" FORMATS)
            (and (VL-POSITION "*" FORMATS)
                 (NOT (VL-POSITION "^A" FORMATS))
            )
        )
      (setq TEXT (ALIGNMENT TEXT))
    )
    (if        (or (VL-POSITION "B" FORMATS)
            (and (VL-POSITION "*" FORMATS)
                 (NOT (VL-POSITION "^B" FORMATS))
            )
        )
      (setq TEXT (TAB TEXT))
    )
    (if        (or (VL-POSITION "C" FORMATS)
            (and (VL-POSITION "*" FORMATS)
                 (NOT (VL-POSITION "^C" FORMATS))
            )
        )
      (setq TEXT (COLOR TEXT))
    )
    (if        (or (VL-POSITION "F" FORMATS)
            (and (VL-POSITION "*" FORMATS)
                 (NOT (VL-POSITION "^F" FORMATS))
            )
        )
      (setq TEXT (FONT TEXT))
    )
    (if        (or (VL-POSITION "H" FORMATS)
            (and (VL-POSITION "*" FORMATS)
                 (NOT (VL-POSITION "^H" FORMATS))
            )
        )
      (setq TEXT (HEIGHT TEXT))
    )
    (if        (or (VL-POSITION "L" FORMATS)
            (and (VL-POSITION "*" FORMATS)
                 (NOT (VL-POSITION "^L" FORMATS))
            )
        )
      (setq TEXT (LINEFEED TEXT))
    )
    (if        (or (VL-POSITION "O" FORMATS)
            (and (VL-POSITION "*" FORMATS)
                 (NOT (VL-POSITION "^O" FORMATS))
            )
        )
      (setq TEXT (OVERLINE TEXT))
    )
    (if        (or (VL-POSITION "P" FORMATS)
            (and (VL-POSITION "*" FORMATS)
                 (NOT (VL-POSITION "^P" FORMATS))
            )
        )
      (setq TEXT (PARAGRAPH TEXT))
    )
    (if        (or (VL-POSITION "Q" FORMATS)
            (and (VL-POSITION "*" FORMATS)
                 (NOT (VL-POSITION "^Q" FORMATS))
            )
        )
      (setq TEXT (OBLIQUE TEXT))
    )
    (if        (or (VL-POSITION "S" FORMATS)
            (and (VL-POSITION "*" FORMATS)
                 (NOT (VL-POSITION "^S" FORMATS))
            )
        )
      (setq TEXT (STACKING TEXT))
    )
    (if        (or (VL-POSITION "T" FORMATS)
            (and (VL-POSITION "*" FORMATS)
                 (NOT (VL-POSITION "^T" FORMATS))
            )
        )
      (setq TEXT (TRACKING TEXT))
    )
    (if        (or (VL-POSITION "U" FORMATS)
            (and (VL-POSITION "*" FORMATS)
                 (NOT (VL-POSITION "^U" FORMATS))
            )
        )
      (setq TEXT (UNDERLINE TEXT))
    )
    (if        (or (VL-POSITION "W" FORMATS)
            (and (VL-POSITION "*" FORMATS)
                 (NOT (VL-POSITION "^W" FORMATS))
            )
        )
      (setq TEXT (WIDTH TEXT))
    )
    (if        (or (VL-POSITION "~" FORMATS)
            (and (VL-POSITION "*" FORMATS)
                 (NOT (VL-POSITION "^~" FORMATS))
            )
        )
      (setq TEXT (HARDSPACE TEXT))
    )
    (setq TEXT (BRACES (XD::String:Replace SLASHFLAG TEXT "\\\\" "")))
    (setq TEXT (XD::String:Replace LBRACE TEXT "\\{" ""))
    (setq TEXT (XD::String:Replace RBRACE TEXT "\\}" ""))
    TEXT
  )

  (defun ISANNOTATIVE (E)
    (and E
         (setq E (CDR (ASSOC 360 (ENTGET E))))
         (setq E (DICTSEARCH E "AcDbContextDataManager"))
         (setq E (DICTSEARCH (CDR (ASSOC -1 E)) "ACDB_ANNOTATIONSCALES"))
         (ASSOC 350 E)
    )
  )

  (defun GETANNOSCALES (E / DICT LST REWIND RES)
    (if        (and E
             (setq DICT (CDR (ASSOC 360 (ENTGET E))))
             (setq LST (DICTSEARCH DICT "AcDbContextDataManager"))
             (setq LST
                    (DICTSEARCH (CDR (ASSOC -1 LST)) "ACDB_ANNOTATIONSCALES")
             )
             (setq DICT (CDR (ASSOC -1 LST)))
        )
      (progn (setq REWIND T)
             (while (setq LST (DICTNEXT DICT REWIND))
               (setq E (CDR (ASSOC 340 LST)))
               (setq RES (CONS (CDR (ASSOC 300 (ENTGET E))) RES))
               (setq REWIND nil)
             )
      )
    )
    (REVERSE RES)
  )

  (defun STRIPCOLUMN (OBJ / ENAME SCLST)
    (if        (and (>= (ATOF (GETVAR "AcadVer")) 17.1)
             (EQ "AcDbMText" (vlax-get OBJ 'OBJECTNAME))
             (setq ENAME (vlax-vla-object->ename OBJ))
        )
      (cond ((and (ISANNOTATIVE ENAME)
                  (setq SCLST (GETANNOSCALES ENAME))
             )
             (SETVAR "cmdecho" 0)
             (command "._chprop" ENAME "" "_Annotative" "_No" "")
             (ENTMOD (APPEND (ENTGET ENAME) '((75 . 0))))
             (command "._chprop" ENAME "" "_Annotative" "_Yes" "")
             (foreach X        SCLST
               (command "._objectscale" ENAME "" "_Add" X "")
             )
             (SETVAR "cmdecho" 1)
            )
            (T (ENTMOD (APPEND (ENTGET ENAME) '((75 . 0)))))
      )
    )
  )

  (defun STRIPMASK (OBJ / FRAME ELST MASKCODE STR MBW)
    (cond
      ((and (EQ "AcDbMText" (vlax-get OBJ 'OBJECTNAME))
            (vlax-property-available-p OBJ 'BACKGROUNDFILL)
       )
       (vlax-put OBJ 'BACKGROUNDFILL 0)
      )
      ((and (WCMATCH (vlax-get OBJ 'OBJECTNAME) "*Dimension*")
            (vlax-property-available-p OBJ 'TEXTFILL)
       )
       (vlax-put OBJ 'TEXTFILL 0)
      )
      ((and (EQ "AcDbMLeader" (vlax-get OBJ 'OBJECTNAME))
            (vlax-property-available-p OBJ 'TEXTFRAMEDISPLAY)
            (setq FRAME (vlax-get OBJ 'TEXTFRAMEDISPLAY))
            (setq ELST (ENTGET (vlax-vla-object->ename OBJ)))
            (setq MASKCODE (ASSOC 292 ELST))
            (/= 0 (CDR MASKCODE))
            (ENTMOD (SUBST (CONS 292 0) MASKCODE ELST))
       )
       (vlax-put OBJ 'TEXTFRAMEDISPLAY FRAME)
      )
      ((and (EQ "AcDbAttribute" (vlax-get OBJ 'OBJECTNAME))
            (ASSOC 90 (ENTGET (vlax-vla-object->ename OBJ)))
       )
       (if (or (= 0 (vlax-get OBJ 'HA**TENSIONDICTIONARY))
               (NOT (VL-CATCH-ALL-ERROR-P
                      (VL-CATCH-ALL-APPLY
                        'vlax-invoke
                        (LIST (vlax-invoke OBJ 'GETEXTENSIONDICTIONARY)
                              'DELETE
                        )
                      )
                    )
               )
           )
         (setq STR (SYMBOLSTRING OBJ))
         (setq STR (GETFIELDS OBJ nil))
       )
       (setq MBW (vlax-get OBJ 'MTEXTBOUNDARYWIDTH))
       (vlax-put OBJ 'MTEXTATTRIBUTE 0)
       (vlax-put OBJ 'MTEXTATTRIBUTE -1)
       (vlax-put OBJ 'TEXTSTRING STR)
       (vlax-put OBJ 'MTEXTBOUNDARYWIDTH MBW)
      )
    )
  )

  (defun STRIPFIELD (OBJ / TYP STR DICT)
    (setq TYP (vlax-get OBJ 'OBJECTNAME))
    (if        (or (EQ TYP "AcDbMText") (EQ TYP "AcDbAttribute"))
      (setq STR (SYMBOLSTRING OBJ))
    )
    (if        (EQ TYP "AcDbAttribute")
      (command "._updatefield" (vlax-vla-object->ename OBJ) "")
    )
    (and (= -1 (vlax-get OBJ 'HA**TENSIONDICTIONARY))
         (NOT (VL-CATCH-ALL-ERROR-P
                (setq DICT (VL-CATCH-ALL-APPLY
                             'vlax-invoke
                             (LIST OBJ 'GETEXTENSIONDICTIONARY)
                           )
                )
              )
         )
         (NOT (VL-CATCH-ALL-ERROR-P
                (VL-CATCH-ALL-APPLY
                  'vlax-invoke
                  (LIST DICT 'REMOVE "ACAD_FIELD")
                )
              )
         )
         (NOT (VL-CATCH-ALL-ERROR-P
                (VL-CATCH-ALL-APPLY 'vlax-invoke (LIST DICT 'DELETE))
              )
         )
         STR
         (VL-CATCH-ALL-APPLY 'vlax-put (LIST OBJ 'TEXTSTRING STR))
    )
    STR
  )

  (defun STRIPTABLEFIELDS
                          (OBJ / ROWS COLUMNS RCLST ROW COL MTXTOBJ STR)
    (setq ROWS (vlax-get OBJ 'ROWS))
    (setq COLUMNS (vlax-get OBJ 'COLUMNS))
    (setq RCLST (ROWSCOLUMNS ROWS COLUMNS))
    (vla-put-RegenerateTableSuppressed OBJ :vlax-true)
    (foreach X RCLST
      (setq ROW (CAR X))
      (setq COL (CADR X))
      (cond ((/= 1 (vlax-invoke OBJ 'GETCELLTYPE ROW COL)))
            ((and (vlax-method-applicable-p OBJ 'GETCELLSTATE)
                  (/= 0 (vlax-invoke OBJ 'GETCELLSTATE ROW COL))
             )
             (setq LOCKEDCELLFLAG T)
            )
            ((and (setq MTXTOBJ (CELLFIELDOWNER OBJ ROW COL))
                  (setq STR (STRIPFIELD MTXTOBJ))
             )
             (vlax-invoke OBJ 'SETTEXT ROW COL STR)
            )
      )
    )
    (vla-put-RegenerateTableSuppressed OBJ :vlax-false)
  )

  (defun STRIPTABLE (OBJ FORMATS / BLOCKS BLKNAME BLKOBJ RCLST ROW COL STR GETSTR MTXTOBJLST
                     TEMPRCLST)
    (setq BLOCKS (SMT-BLOCKS))
    (setq BLKNAME (CDR (ASSOC 2 (ENTGET (vlax-vla-object->ename OBJ)))))
    (setq BLKOBJ (vla-Item BLOCKS BLKNAME))
    (vlax-for X        BLKOBJ
      (if (and (EQ "AcDbMText" (vlax-get X 'OBJECTNAME))
               (NOT (EQ "" (vlax-get X 'TEXTSTRING)))
          )
        (setq MTXTOBJLST (CONS X MTXTOBJLST))
      )
    )
    (setq
      RCLST (ROWSCOLUMNS (vlax-get OBJ 'ROWS) (vlax-get OBJ 'COLUMNS))
    )
    (foreach X RCLST
      (setq ROW (CAR X))
      (setq COL (CADR X))
      (if (and (vlax-method-applicable-p OBJ 'GETCELLSTATE)
               (/= 0 (vlax-invoke OBJ 'GETCELLSTATE ROW COL))
          )
        (setq LOCKEDCELLFLAG T)
      )
      (if (NOT (EQ "" (vlax-invoke OBJ 'GETTEXT ROW COL)))
        (setq TEMPRCLST (CONS X TEMPRCLST))
      )
    )
    (vla-put-RegenerateTableSuppressed OBJ acTrue)
    (if        (= (LENGTH MTXTOBJLST) (LENGTH TEMPRCLST))
      (foreach X MTXTOBJLST
        (setq STR (SYMBOLSTRING X))
        (setq ROW (CAAR TEMPRCLST))
        (setq COL (CADAR TEMPRCLST))
        (setq STR (STRIPFORMAT STR FORMATS))
        (vlax-put X 'TEXTSTRING STR)
        (setq STR (vlax-invoke X 'FIELDCODE))
        (VL-CATCH-ALL-APPLY
          'vlax-invoke
          (LIST OBJ 'SETTEXT ROW COL STR)
        )
        (setq TEMPRCLST (CDR TEMPRCLST))
      )
    )
    (vla-put-RegenerateTableSuppressed OBJ acFalse)
  )

  (defun STRIPMLEADER (OBJ FORMATS)
    (if
      (or (= 0 (vlax-get OBJ 'HA**TENSIONDICTIONARY))
          (NOT
            (VL-CATCH-ALL-ERROR-P
              (VL-CATCH-ALL-APPLY
                'vlax-invoke
                (LIST (vlax-invoke OBJ 'GETEXTENSIONDICTIONARY) 'DELETE)
              )
            )
          )
      )
       (vlax-put OBJ
                 'TEXTSTRING
                 (STRIPFORMAT (SYMBOLSTRING OBJ) FORMATS)
       )
       (progn (vlax-put OBJ 'TEXTSTRING (GETFIELDS OBJ FORMATS))
              (SETVAR "cmdecho" 0)
              (VL-CMDF "._updatefield" (vlax-vla-object->ename OBJ) "")
              (SETVAR "cmdecho" 1)
              (vla-Update OBJ)
              (vlax-put        OBJ
                        'TEXTFRAMEDISPLAY
                        (vlax-get OBJ 'TEXTFRAMEDISPLAY)
              )
       )
    )
  )

  (defun STRIPMATTRIBUTE (OBJ FORMATS)
    (if
      (or (= 0 (vlax-get OBJ 'HA**TENSIONDICTIONARY))
          (NOT
            (VL-CATCH-ALL-ERROR-P
              (VL-CATCH-ALL-APPLY
                'vlax-invoke
                (LIST (vlax-invoke OBJ 'GETEXTENSIONDICTIONARY) 'DELETE)
              )
            )
          )
      )
       (vlax-put OBJ
                 'TEXTSTRING
                 (STRIPFORMAT (SYMBOLSTRING OBJ) FORMATS)
       )
       (progn (vlax-put OBJ 'TEXTSTRING (GETFIELDS OBJ FORMATS))
              (vla-Update OBJ)
       )
    )
  )

  (defun ROWSCOLUMNS (R C / N CLST RLST LST)
    (setq N 0)
    (while (< N R) (setq RLST (CONS N RLST)) (setq N (1+ N)))
    (setq N 0)
    (while (< N C) (setq CLST (CONS N CLST)) (setq N (1+ N)))
    (foreach R RLST
      (foreach C CLST (setq LST (CONS (LIST R C) LST)))
    )
  )

  (defun CELLFIELDOWNER        (TBLOBJ ROW COL / DOC ID OWNER)
    (setq DOC (SMT-DOC))
    (and (setq ID (vlax-invoke TBLOBJ 'GETFIELDID ROW COL))
         (/= 0 ID)
         (setq OWNER (vlax-invoke DOC 'OBJECTIDTOOBJECT ID))
         (repeat 3
           (setq OWNER (vlax-invoke
                         DOC
                         'OBJECTIDTOOBJECT
                         (vlax-get OWNER 'OWNERID)
                       )
           )
         )
    )
    OWNER
  )

  (defun SYMBOLSTRING (OBJ / E TYP STR NAME STRING BLOCKS)
    (defun STRING (ENAME / STR LST)
      (setq STR "")
      (setq LST        (VL-REMOVE-IF-NOT
                  '(LAMBDA (X) (OR (= 3 (CAR X)) (= 1 (CAR X))))
                  (ENTGET ENAME)
                )
      )
      (if (and (< 1 (LENGTH LST)) (= 1 (CAAR LST)))
        (setq LST (CDR LST))
      )
      (foreach X LST (setq STR (STRCAT STR (CDR X))))
    )
    (if        (= (TYPE OBJ) 'VLA-OBJECT)
      (setq E (vlax-vla-object->ename OBJ))
      (progn (setq E OBJ) (setq OBJ (vlax-ename->vla-object OBJ)))
    )
    (setq TYP (vlax-get OBJ 'OBJECTNAME))
    (cond ((or (EQ TYP "AcDbMText") (EQ TYP "AcDbAttribute"))
           (setq STR (STRING E))
          )
          ((EQ TYP "AcDbMLeader")
           (setq STR (CDR (ASSOC 304 (ENTGET E))))
          )
          ((WCMATCH TYP "*Dimension*")
           (setq STR (CDR (ASSOC 1 (ENTGET E))))
          )
    )
    STR
  )

  (defun GETFIELDS (OBJ                 FORMATS      /                   SRCDICT        SRCDICTENAME
                    SRCTEXTDICT         SRCFIELDENAME                   TARGDICT        TARGDICTENAME
                    FIELDELST         FIELDDICT    DICTS           ACTLAY        TEMPOBJ
                    LOCKFLAG         RES              DOC
                   )
    (setq DOC (SMT-DOC))
    (if        (and (= -1 (vlax-get OBJ 'HA**TENSIONDICTIONARY))
             (setq SRCDICT (vlax-invoke OBJ 'GETEXTENSIONDICTIONARY))
             (setq SRCDICTENAME (vlax-vla-object->ename SRCDICT))
             (setq SRCTEXTDICT (DICTSEARCH SRCDICTENAME "ACAD_FIELD"))
             (setq SRCFIELDENAME (CDR (ASSOC 360 SRCTEXTDICT)))
        )
      (progn (setq ACTLAY (vlax-get DOC 'ACTIVELAYER))
             (if (= -1 (vlax-get ACTLAY 'LOCK))
               (progn (vlax-put ACTLAY 'LOCK 0) (setq LOCKFLAG T))
             )
             (setq TEMPOBJ (vlax-invoke
                             (vlax-get (vla-get-ActiveLayout DOC) 'BLOCK)
                             'ADDMTEXT
                             '(0.0 0.0 0.0)
                             0.0
                             "x"
                           )
             )
             (setq TARGDICT (vlax-invoke TEMPOBJ 'GETEXTENSIONDICTIONARY))
             (setq TARGDICTENAME (vlax-vla-object->ename TARGDICT))
             (setq FIELDELST (ENTGET SRCFIELDENAME))
             (setq FIELDELST (VL-REMOVE (ASSOC 5 FIELDELST) FIELDELST))
             (setq FIELDELST (VL-REMOVE (ASSOC -1 FIELDELST) FIELDELST))
             (setq FIELDELST (VL-REMOVE (ASSOC 102 FIELDELST) FIELDELST))
             (setq FIELDELST (VL-REMOVE-IF
                               '(LAMBDA (X) (= 330 (CAR X)))
                               FIELDELST
                             )
             )
             (foreach X        FIELDELST
               (if (= 360 (CAR X))
                 (setq DICTS (CONS (CDR X) DICTS))
               )
             )
             (setq FIELDELST (VL-REMOVE-IF
                               '(LAMBDA (X) (= 360 (CAR X)))
                               FIELDELST
                             )
             )
             (foreach X        (REVERSE DICTS)
               (setq
                 FIELDELST (APPEND FIELDELST
                                   (LIST (CONS 360 (ENTMAKEX (ENTGET X))))
                           )
               )
             )
             (setq FIELDDICT (DICTADD TARGDICTENAME
                                      "ACAD_FIELD"
                                      (ENTMAKEX        '((0 . "DICTIONARY")
                                                  (100 . "AcDbDictionary")
                                                  (280 . 1)
                                                  (281 . 1)
                                                 )
                                      )
                             )
             )
             (DICTADD FIELDDICT "TEXT" (ENTMAKEX FIELDELST))
             (vlax-put TEMPOBJ
                       'TEXTSTRING
                       (STRIPFORMAT (SYMBOLSTRING TEMPOBJ) FORMATS)
             )
             (setq RES (vlax-invoke TEMPOBJ 'FIELDCODE))
             (vla-Delete TEMPOBJ)
             (if LOCKFLAG
               (vlax-put ACTLAY 'LOCK -1)
             )
      )
      (setq RES (STRIPFORMAT (SYMBOLSTRING OBJ) FORMATS))
    )
    RES
  )

  (defun txtstring (obj / STR)
    (setq Str (vlax-get obj 'TextString))
    (foreach x '("%%O" "%%o" "%%u" "%%U" "%%140" "%%141" "%%142" "%%143")
     (while (wcmatch x Str) (setq Str (XD::String:Replace x STR "" "")))
    )
    Str
  )


  (VL-LOAD-COM)
  (setq ACADVER (ATOF (GETVAR "acadver")))
  (if (<= 15.0 ACADVER)
    (setq FORMATS '("A" "B" "C" "F" "H" "L" "O" "Q" "P" "S" "T" "U" "W" "~"))
  )
  (if (<= 16.1 ACADVER)
    (setq FORMATS '("A" "B" "C" "F" "H" "L" "O" "Q" "P" "S" "T" "U" "W" "~" "M" "D"))
  )
  (if (<= 17.1 ACADVER)
    (setq FORMATS '("A" "B" "C" "F" "H" "L" "O" "Q" "P" "S" "T" "U" "W" "~" "M" "D" "N"))
  )
  (setq FORMATS (FORMATSTOLIST FORMATS))

  (setq OBJ (vlax-ename->vla-object (car (nentsel))))
  (setq OBJNAME (vlax-get-property OBJ "ObjectName"))
  (cond
    ((EQ OBJNAME "AcDbMText")
     (setq MTEXTOBJLST OBJ)
    )
    ((and (EQ OBJNAME "AcDbMLeader")
          (vlax-property-available-p OBJ 'CONTENTTYPE)
          (= 2 (vlax-get OBJ 'CONTENTTYPE))
     )
     (setq MLDROBJLST OBJ)
    )
    ((and (EQ OBJNAME "AcDbBlockReference")
          (vlax-property-available-p OBJ 'HASATTRIBUTES)
          (= -1 (vlax-get OBJ 'HASATTRIBUTES))
          (vlax-method-applicable-p OBJ 'GETATTRIBUTES)
     )
     (foreach X        (vlax-invoke OBJ 'GETATTRIBUTES)
       (if
         (and (vlax-property-available-p X 'MTEXTATTRIBUTE)
              (= -1 (vlax-get X 'MTEXTATTRIBUTE))
              (= 0
                 (vlax-get (vla-Item LAYERS (vlax-get X 'LAYER)) 'LOCK)
              )
         )
          (setq MATTOBJLST OBJ)
       )
     )
    )
    ((VL-POSITION
       OBJNAME
       '("AcDbAlignedDimension"                    "AcDbRotatedDimension"
         "AcDbOrdinateDimension"            "AcDsbAngularDimension"
         "AcsDb2LineAngularDimension"            "AcDb3PointAngularDimension"
         "AscDbDiametricDimension"            "AcDbRadialDimension"
         "AcDbRadialDimensionLarge"            "AcDbArcDimension"
        )
     )
     (setq DIMOBJLST OBJ)
    )
    ((EQ OBJNAME "AcDbTable")
     (setq TABLEOBJLST OBJ)
    )
    ((EQ OBJNAME "AcDbText")
     (setq TextLST OBJ)
    )
    ((EQ OBJNAME (EQ OBJNAME "AcDbAttributeDefinition"))
     (setq TextLST OBJ)
    )
  )

  (if (or (VL-POSITION "*" FORMATS) (VL-POSITION "D" FORMATS))
    (cond (MTEXTOBJLST (STRIPFIELD MTEXTOBJLST))
          (MLDROBJLST (STRIPFIELD MLDROBJLST))
          (DIMOBJLST (STRIPFIELD DIMOBJLST))
          (MATTOBJLST (STRIPFIELD MATTOBJLST))
          (TABLEOBJLST (STRIPTABLEFIELDS TABLEOBJLST))
    )
  )
  (if (or (VL-POSITION "*" FORMATS) (VL-POSITION "N" FORMATS))
    (foreach X MTEXTOBJLST (STRIPCOLUMN X))
  )
  (if (or (VL-POSITION "*" FORMATS) (VL-POSITION "M" FORMATS))
    (cond (MTEXTOBJLST (STRIPMASK MTEXTOBJLST))
          (MLDROBJLST (STRIPMASK MLDROBJLST))
          (DIMOBJLST (STRIPMASK DIMOBJLST))
          (MATTOBJLST (STRIPMASK MATTOBJLST))
    )
  )
  (setq        FORMATS        (VL-REMOVE-IF
                  '(LAMBDA (KEY)
                     (VL-POSITION KEY '("M" "D" "N" "^M" "^D" "^N"))
                   )
                  FORMATS
                )
  )

  (if FORMATS
    (cond (MTEXTOBJLST (STRIPFORMAT (SYMBOLSTRING MTEXTOBJLST) FORMATS))
          (MLDROBJLST (STRIPMLEADER MLDROBJLST FORMATS))
          (DIMOBJLST (STRIPFORMAT (SYMBOLSTRING X) FORMATS))
          (MATTOBJLST (STRIPMATTRIBUTE MATTOBJLST FORMATS))
          (TABLEOBJLST (STRIPTABLE TABLEOBJLST FORMATS))
          (TextLST (txtstring obj))
    )
  )
)

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-11-23 09:10 , Processed in 0.238141 second(s), 65 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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