乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 ☆ ☆ ☆ 尊重版权，从我做起，拒绝盗版，拒绝倒卖 ☆ ☆ ☆ 签到、发布资源、邀请好友注册，可以获得银币 ☆ ☆ ☆ 请注意保管好自己的密码，避免账户资金被盗
查看： 20|回复： 9

[编程交流] 文字到多行文字lisp-添加backgr

[复制链接]
mawelby

1

主题

5

帖子

4

银币

初来乍到

Rank: 1

铜币
5
发表于 2022-7-6 10:51:55 | 显示全部楼层 |阅读模式
这是我第一次冒险进入世界。lsp和代码，需要一些指导。
 
我有下面的代码，它可以很好地将文本转换为多行文字，但不能将文本组合成一个多行文字块。我需要实现的是，让这段代码也添加一个空白为1的清晰背景掩码，然后在绘图顺序中带到前面。如果有人能给我指出一个好的资源来学习如何做到这一点，我将不胜感激。
 
  1. (defun c:t2m (/ sset count num en el mcontent bbox point1 point2 point3 point4 mwidth mheight mstyle njust mrotate nmtext)
  2. (setvar "cmdecho" 0)
  3. (setq sset (ai_aselect))
  4. (if (null sset)
  5.         (progn
  6.                 (princ "\nNo objects selected.")
  7.                 (exit)
  8.         )
  9. )
  10. (setq count 0)
  11. (while (/= (ssname sset COUNT) nil)
  12.         (setq EN (ssname sset COUNT))
  13.         (setq EL (entget EN))
  14.         (if (= (cdr (assoc 0 EL)) "TEXT")
  15.                 (progn
  16.                         (setq mcontent (cons '1 (strcase (cdr (assoc 1 el)))))
  17.                         (setq bbox (acet-geom-textbox EL 0.1))
  18.                         (setq point1 (car bbox))
  19.                         (setq point2 (cadr bbox))
  20.                         (setq point3 (cadr (cdr bbox)))
  21.                         (setq point4 (cadr (cdr (cdr bbox))))
  22.                         (setq mwidth (cons '41 (distance point1 point2)))
  23.                         (setq mheight (cons '40 (cdr (assoc 40 el))))
  24.                         (setq mstyle (cons '7 (cdr (assoc 7 el))))
  25.                         (setq nspace (cons '410 (cdr (assoc 410 EL))))
  26.                         (setq minsert (cons '10 (cdr (assoc 10 EL))))
  27.                         (cond
  28.                                 ((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 1)));JY
  29.                                 ((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 2)));JU
  30.                                 ((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 3)));JI
  31.                                 ((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 7)));JN
  32.                                 ((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 7)));JN
  33.                                 ((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 6)));JK
  34.                                 ((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
  35.                                 ((and (= (cdr (assoc 72 el)) 4)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
  36.                                 ((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 7)));JN
  37.                                 ((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
  38.                                 ((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 ));JM
  39.                                 ((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 9)));J,
  40.                                 ((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
  41.                         )
  42.                         (setq mrotate (cons '50 (cdr (assoc 50 el))))
  43.                         (setq nmtext (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(67 . 0) nspace '(8 . "TEXT") '(100 . "AcDbMText") minsert njust mheight mwidth mstyle mcontent mrotate))
  44.                         (entmake nmtext)
  45.                         (entdel en)
  46.                         (setq count (+ count 1))
  47.                 )
  48.                 (setq count (+ count 1))
  49.         )
  50. )
  51. (setvar "cmdecho" 1)(princ)
  52. )
回复

使用道具 举报

VVA

1

主题

308

帖子

308

银币

初来乍到

Rank: 1

铜币
8
发表于 2022-7-6 11:03:13 | 显示全部楼层
试试看
  2. (defun c:t2m (/ sset count num en el mcontent bbox point1 point2 point3 point4 mwidth mheight mstyle njust mrotate nmtext ss)
  3. (setvar "cmdecho" 0)
  4. (setq sset (ai_aselect))
  5. (if (null sset)
  6.         (progn
  7.                 (princ "\nNo objects selected.")
  8.                 (exit)
  9.         )
  10. )
  11. (setq count 0 ss (ssadd))
  12. (while (ssname sset COUNT)
  13.         (setq EN (ssname sset COUNT))
  14.         (setq EL (entget EN))
  15.         (if (= (cdr (assoc 0 EL)) "TEXT")
  16.                 (progn
  17.                         (setq mcontent (cons '1 (strcase (cdr (assoc 1 el)))))
  18.                         (setq bbox (acet-geom-textbox EL 0.1))
  19.                         (setq point1 (car bbox))
  20.                         (setq point2 (cadr bbox))
  21.                         (setq point3 (cadr (cdr bbox)))
  22.                         (setq point4 (cadr (cdr (cdr bbox))))
  23.                         (setq mwidth (cons '41 (distance point1 point2)))
  24.                         (setq mheight (cons '40 (cdr (assoc 40 el))))
  25.                         (setq mstyle (cons '7 (cdr (assoc 7 el))))
  26.                         (setq nspace (cons '410 (cdr (assoc 410 EL))))
  27.                         (setq minsert (cons '10 (cdr (assoc 10 EL))))
  28.                         (cond
  29.                                 ((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 1)));JY
  30.                                 ((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 2)));JU
  31.                                 ((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 3)));JI
  32.                                 ((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 7)));JN
  33.                                 ((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 7)));JN
  34.                                 ((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 6)));JK
  35.                                 ((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
  36.                                 ((and (= (cdr (assoc 72 el)) 4)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
  37.                                 ((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 7)));JN
  38.                                 ((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
  39.                                 ((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 ));JM
  40.                                 ((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 9)));J,
  41.                                 ((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
  42.                         )
  43.                         (setq mrotate (cons '50 (cdr (assoc 50 el))))
  44.                         (setq nmtext (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(67 . 0) nspace '(8 . "TEXT") '(100 . "AcDbMText") minsert njust mheight mwidth mstyle mcontent mrotate))
  45.                         [color="Red"](ssadd
  46.                                  (mip-mtext-mask (entmakex nmtext) t)
  47.                                  ss
  48.                                  )[/color]
  49.                         (entdel en)
  50.                         (setq count (+ count 1))
  51.                 )
  52.                 (setq count (+ count 1))
  53.         )
  54. )
  55.  (if (> (sslength ss) 0)(command "_draworder" ss "" "_F"))
  56. (setvar "cmdecho" 1)(princ)
  57. )
  58. (defun mip-mtext-mask (ent OnOff / ed)
  59. ;;; ent -mtext ename
  60. ;;; OnOff - t - on mtext mask
  61. ;;; nil - off (unmask mtext)
  63.  (setq ed (vl-remove-if
  64.             '(lambda (x) (member (car x) '(90 63 421 45 441)))
  65.             (entget ent)
  66.           ) ;_ end of vl-remove-if
  67.  ) ;_ end of setq
  68.  (if OnOFF
  69.    (setq ed (append ed
  70.                     '((90 . 3)
  71.                       (63 . 9)
  72.                       (421 . 13158600)
  73.                       (45 . 1.01) 
  74.                       (441 . 6042092)
  75.                      )
  76.             ) ;_ end of append
  77.    ) ;_ end of setq
  78.    (setq ed (append ed '((90 . 2))))
  79.  ) ;_ end of if
  80.  (entmod ed)
  81.  (entupd ent)
  82. )
回复

使用道具 举报

VVA

1

主题

308

帖子

308

银币

初来乍到

Rank: 1

铜币
8
发表于 2022-7-6 11:06:33 | 显示全部楼层
txt2mtxt-来自Express Tools
Lee Mac Text 2多行文字升级
回复

使用道具 举报

mawelby

1

主题

5

帖子

4

银币

初来乍到

Rank: 1

铜币
5
发表于 2022-7-6 11:12:09 | 显示全部楼层
谢谢，但是在运行lisp时出现以下错误：
 
; 错误：错误字符读取（八进制）：0
 
知道为什么吗？
回复

使用道具 举报

VVA

1

主题

308

帖子

308

银币

初来乍到

Rank: 1

铜币
8
发表于 2022-7-6 11:19:11 | 显示全部楼层
使用expample附着dwg文件
回复

使用道具 举报

mawelby

1

主题

5

帖子

4

银币

初来乍到

Rank: 1

铜币
5
发表于 2022-7-6 11:25:21 | 显示全部楼层
我认为dwg无关紧要。错误在于加载lisp，而不是运行lisp。很抱歉给您带来困惑。
 
这是命令行文本（t2m2.lsp是您在第一篇文章中编写的代码）：
 
命令：appload
t2m2.lsp已成功加载。
命令：；错误：错误字符读取（八进制）：0
回复

使用道具 举报

VVA

1

主题

308

帖子

308

银币

初来乍到

Rank: 1

铜币
8
发表于 2022-7-6 11:35:35 | 显示全部楼层
我认为您正在使用Autocad的中文版本。类似问题
我编辑#2（从评论中删除俄语文本）
现在可以了？
回复

使用道具 举报

mawelby

1

主题

5

帖子

4

银币

初来乍到

Rank: 1

铜币
5
发表于 2022-7-6 11:40:11 | 显示全部楼层
我想我已经删除了所有俄语文本，但在加载时仍然出现错误：
 
  1. (defun c:t2m (/ sset count num en el mcontent bbox point1 point2 point3 point4 mwidth mheight mstyle njust mrotate nmtext ss)
  2. (setvar "cmdecho" 0)
  3. (setq sset (ai_aselect))
  4. (if (null sset)
  5.         (progn
  6.                 (princ "\nNo objects selected.")
  7.                 (exit)
  8.         )
  9. )
  10. (setq count 0 ss (ssadd))
  11. (while (ssname sset COUNT)
  12.         (setq EN (ssname sset COUNT))
  13.         (setq EL (entget EN))
  14.         (if (= (cdr (assoc 0 EL)) "TEXT")
  15.                 (progn
  16.                         (setq mcontent (cons '1 (strcase (cdr (assoc 1 el)))))
  17.                         (setq bbox (acet-geom-textbox EL 0.1))
  18.                         (setq point1 (car bbox))
  19.                         (setq point2 (cadr bbox))
  20.                         (setq point3 (cadr (cdr bbox)))
  21.                         (setq point4 (cadr (cdr (cdr bbox))))
  22.                         (setq mwidth (cons '41 (distance point1 point2)))
  23.                         (setq mheight (cons '40 (cdr (assoc 40 el))))
  24.                         (setq mstyle (cons '7 (cdr (assoc 7 el))))
  25.                         (setq nspace (cons '410 (cdr (assoc 410 EL))))
  26.                         (setq minsert (cons '10 (cdr (assoc 10 EL))))
  27.                         (cond
  28.                                 ((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 1)));JY
  29.                                 ((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 2)));JU
  30.                                 ((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 3)));JI
  31.                                 ((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 7)));JN
  32.                                 ((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 7)));JN
  33.                                 ((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 6)));JK
  34.                                 ((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
  35.                                 ((and (= (cdr (assoc 72 el)) 4)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
  36.                                 ((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 7)));JN
  37.                                 ((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
  38.                                 ((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 ));JM
  39.                                 ((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 9)));J,
  40.                                 ((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
  41.                         )
  42.                         (setq mrotate (cons '50 (cdr (assoc 50 el))))
  43.                         (setq nmtext (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(67 . 0) nspace '(8 . "TEXT") '(100 . "AcDbMText") minsert njust mheight mwidth mstyle mcontent mrotate))
  44.                         (ssadd
  45.                                  (mip-mtext-mask (entmakex nmtext) t)
  46.                                  ss
  47.                                  )
  48.                         (entdel en)
  49.                         (setq count (+ count 1))
  50.                 )
  51.                 (setq count (+ count 1))
  52.         )
  53. )
  54.  (if (> (sslength ss) 0)(command "_draworder" ss "" "_F"))
  55. (setvar "cmdecho" 1)(princ)
  56. )
  57. (defun mip-mtext-mask (ent OnOff / ed)
  58. ;;; ent -mtext ename
  59. ;;; OnOff - t - on mtext mask
  60. ;;; nil - off (unmask mtext)
  62.  (setq ed (vl-remove-if
  63.             '(lambda (x) (member (car x) '(90 63 421 45 441)))
  64.             (entget ent)
  65.           ) ;_ end of vl-remove-if
  66.  ) ;_ end of setq
  67.  (if OnOFF
  68. ;;;
  69.    (setq ed (append ed
  70.                     '((90 . 3)
  71.                       (63 . 9)
  72.                       (421 . 13158600)
  73.                       (45 . 1.01)
  74.                       (441 . 6042092)
  75.                      )
  76.             ) ;_ end of append
  77.    ) ;_ end of setq
  78.    (setq ed (append ed '((90 . 2))))
  79.  ) ;_ end of if
  80.  (entmod ed)
  81.  (entupd ent)
  82. )
回复

使用道具 举报

VVA

1

主题

308

帖子

308

银币

初来乍到

Rank: 1

铜币
8
发表于 2022-7-6 11:51:40 | 显示全部楼层
我不知道。这个代码适合我。我做了一些改变。尝试新版本。
  2. (defun c:t2m (/        sset     count    num      en       el
  3.              mcontent bbox     point1   point2   point3   point4
  4.              mwidth   mheight  mstyle   njust    mrotate  nmtext
  5.              ss
  6.             )
  7.  (vl-load-com)
  8.  (setvar "cmdecho" 0)
  9.  (if (setq sset (ssget "_:L" '((0 . "TEXT"))))
  10.  (progn  
  11.  (setq count 0
  12.        ss    (ssadd)
  13.  ) ;_ end of setq
  14.  (while (ssname sset COUNT)
  15.    (setq EN (ssname sset COUNT))
  16.    (setq EL (entget EN))
  17.    (if (= (cdr (assoc 0 EL)) "TEXT")
  18.      (progn
  19.        (setq mcontent (cons '1 (strcase (cdr (assoc 1 el)))))
  20.        (setq EL (subst mcontent(assoc 1 EL) EL))
  21.        (setq bbox (acet-geom-textbox EL 0.1))
  22.        (setq point1 (car bbox))
  23.        (setq point2 (cadr bbox))
  24.        (setq point3 (cadr (cdr bbox)))
  25.        (setq point4 (cadr (cdr (cdr bbox))))
  26.        (setq mwidth (cons '41 (distance point1 point2)))
  27.        (setq mheight (cons '40 (cdr (assoc 40 el))))
  28.        (setq mstyle (cons '7 (cdr (assoc 7 el))))
  29.        (setq nspace (cons '410 (cdr (assoc 410 EL))))
  30.        (setq minsert (cons '10 (cdr (assoc 10 EL))))
  31.        (cond
  32.          ((and (= (cdr (assoc 72 el)) 0) (= (cdr (assoc 73 el)) 3))
  33.           (setq NJUST (cons '71 1))
  34.          )                                       ;JY
  35.          ((and (= (cdr (assoc 72 el)) 1) (= (cdr (assoc 73 el)) 3))
  36.           (setq NJUST (cons '71 2))
  37.          )                                       ;JU
  38.          ((and (= (cdr (assoc 72 el)) 2) (= (cdr (assoc 73 el)) 3))
  39.           (setq NJUST (cons '71 3))
  40.          )                                       ;JI
  41.          ((and (= (cdr (assoc 72 el)) 0) (= (cdr (assoc 73 el)) 2))
  42.           (setq NJUST (cons '71 7))
  43.          )                                       ;JN
  44.          ((and (= (cdr (assoc 72 el)) 1) (= (cdr (assoc 73 el)) 2))
  45.           (setq NJUST (cons '71 7))
  46.          )                                       ;JN
  47.          ((and (= (cdr (assoc 72 el)) 2) (= (cdr (assoc 73 el)) 2))
  48.           (setq NJUST (cons '71 6))
  49.          )                                       ;JK
  50.          ((and (= (cdr (assoc 72 el)) 0) (= (cdr (assoc 73 el)) 0))
  51.           (setq NJUST (cons '71 7))
  52.          )                                       ;JN
  53.          ((and (= (cdr (assoc 72 el)) 4) (= (cdr (assoc 73 el)) 0))
  54.           (setq NJUST (cons '71 7))
  55.          )                                       ;JN
  56.          ((and (= (cdr (assoc 72 el)) 0) (= (cdr (assoc 73 el)) 1))
  57.           (setq NJUST (cons '71 7))
  58.          )                                       ;JN
  59.          ((and (= (cdr (assoc 72 el)) 1) (= (cdr (assoc 73 el)) 0))
  60.           (setq NJUST (cons '71 7))
  61.          )                                       ;JN
  62.          ((and (= (cdr (assoc 72 el)) 1) (= (cdr (assoc 73 el)) 1))
  63.           (setq NJUST (cons '71 )
  64.          )                                       ;JM
  65.          ((and (= (cdr (assoc 72 el)) 2) (= (cdr (assoc 73 el)) 1))
  66.           (setq NJUST (cons '71 9))
  67.          )                                       ;J,
  68.          ((and (= (cdr (assoc 72 el)) 2) (= (cdr (assoc 73 el)) 0))
  69.           (setq NJUST (cons '71 7))
  70.          )                                       ;JN
  71.        ) ;_ end of cond
  72.        (setq mrotate (cons '50 (cdr (assoc 50 el))))
  73.        (setq nmtext (list '(0 . "MTEXT")   '(100 . "AcDbEntity")
  74.                           '(67 . 0)        nspace
  75.                           '(8 . "TEXT")    '(100 . "AcDbMText")
  76.                           minsert          njust
  77.                           mheight          mwidth
  78.                           mstyle           mcontent
  79.                           mrotate
  80.                          ) ;_ end of list
  81.        ) ;_ end of setq
  82.        (vla-put-backgroundfill
  83.          (vlax-ename->vla-object (entmakex nmtext))
  84.          :vlax-true
  85.        ) ;_ end of vla-put-BackgroundFill
  86.        (ssadd (entlast) ss)
  87.        (entdel en)
  88.        (setq count (+ count 1))
  89.      ) ;_ end of progn
  90.      (setq count (+ count 1))
  91.    ) ;_ end of if
  92.  ) ;_ end of while
  93.  (if (> (sslength ss) 0)
  94.    (command "_draworder" ss "" "_F")
  95.  ) ;_ end of if
  96.  )
  97.  (princ "\nNo objects selected.")
  98. )
  99.  (setvar "cmdecho" 1)
  100.  (princ)
  101. ) ;_ end of defun
回复

使用道具 举报

mawelby

1

主题

5

帖子

4

银币

初来乍到

Rank: 1

铜币
5
发表于 2022-7-6 11:56:33 | 显示全部楼层
似乎正在工作。非常感谢你的帮助。
回复

使用道具 举报

返回列表 发帖

发表回复

高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

精选推荐

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-3-6 17:12 , Processed in 0.537980 second(s), 72 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表