文字到多行文字lisp-添加backgr 乐筑天下

mawelby 发表于 2022-7-6 10:51:55

文字到多行文字lisp-添加backgr

这是我第一次冒险进入世界。lsp和代码，需要一些指导。

我有下面的代码，它可以很好地将文本转换为多行文字，但不能将文本组合成一个多行文字块。我需要实现的是，让这段代码也添加一个空白为1的清晰背景掩码，然后在绘图顺序中带到前面。如果有人能给我指出一个好的资源来学习如何做到这一点，我将不胜感激。

(defun c:t2m (/ sset count num en el mcontent bbox point1 point2 point3 point4 mwidth mheight mstyle njust mrotate nmtext)
(setvar "cmdecho" 0)
(setq sset (ai_aselect))
(if (null sset)
(progn
(princ "\nNo objects selected.")
(exit)
)
)
(setq count 0)
(while (/= (ssname sset COUNT) nil)
(setq EN (ssname sset COUNT))
(setq EL (entget EN))
(if (= (cdr (assoc 0 EL)) "TEXT")
(progn
(setq mcontent (cons '1 (strcase (cdr (assoc 1 el)))))
(setq bbox (acet-geom-textbox EL 0.1))
(setq point1 (car bbox))
(setq point2 (cadr bbox))
(setq point3 (cadr (cdr bbox)))
(setq point4 (cadr (cdr (cdr bbox))))
(setq mwidth (cons '41 (distance point1 point2)))
(setq mheight (cons '40 (cdr (assoc 40 el))))
(setq mstyle (cons '7 (cdr (assoc 7 el))))
(setq nspace (cons '410 (cdr (assoc 410 EL))))
(setq minsert (cons '10 (cdr (assoc 10 EL))))
(cond
((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 1)));JY
((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 2)));JU
((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 3)));JI
((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 7)));JN
((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 7)));JN
((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 6)));JK
((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
((and (= (cdr (assoc 72 el)) 4)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 7)));JN
((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 ));JM
((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 9)));J,
((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
)
(setq mrotate (cons '50 (cdr (assoc 50 el))))
(setq nmtext (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(67 . 0) nspace '(8 . "TEXT") '(100 . "AcDbMText") minsert njust mheight mwidth mstyle mcontent mrotate))
(entmake nmtext)
(entdel en)
(setq count (+ count 1))
)
(setq count (+ count 1))
)
)
(setvar "cmdecho" 1)(princ)
)

VVA 发表于 2022-7-6 11:03:13

试试看

(defun c:t2m (/ sset count num en el mcontent bbox point1 point2 point3 point4 mwidth mheight mstyle njust mrotate nmtext ss)
(setvar "cmdecho" 0)
(setq sset (ai_aselect))
(if (null sset)
(progn
(princ "\nNo objects selected.")
(exit)
)
)
(setq count 0 ss (ssadd))
(while (ssname sset COUNT)
(setq EN (ssname sset COUNT))
(setq EL (entget EN))
(if (= (cdr (assoc 0 EL)) "TEXT")
(progn
(setq mcontent (cons '1 (strcase (cdr (assoc 1 el)))))
(setq bbox (acet-geom-textbox EL 0.1))
(setq point1 (car bbox))
(setq point2 (cadr bbox))
(setq point3 (cadr (cdr bbox)))
(setq point4 (cadr (cdr (cdr bbox))))
(setq mwidth (cons '41 (distance point1 point2)))
(setq mheight (cons '40 (cdr (assoc 40 el))))
(setq mstyle (cons '7 (cdr (assoc 7 el))))
(setq nspace (cons '410 (cdr (assoc 410 EL))))
(setq minsert (cons '10 (cdr (assoc 10 EL))))
(cond
((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 1)));JY
((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 2)));JU
((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 3)));JI
((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 7)));JN
((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 7)));JN
((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 6)));JK
((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
((and (= (cdr (assoc 72 el)) 4)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 7)));JN
((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 ));JM
((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 9)));J,
((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
)
(setq mrotate (cons '50 (cdr (assoc 50 el))))
(setq nmtext (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(67 . 0) nspace '(8 . "TEXT") '(100 . "AcDbMText") minsert njust mheight mwidth mstyle mcontent mrotate))
(ssadd
                              (mip-mtext-mask (entmakex nmtext) t)
                              ss
                              )
(entdel en)
(setq count (+ count 1))
)
(setq count (+ count 1))
)
)
(if (> (sslength ss) 0)(command "_draworder" ss "" "_F"))
(setvar "cmdecho" 1)(princ)
)
(defun mip-mtext-mask (ent OnOff / ed)
;;; ent -mtext ename
;;; OnOff - t - on mtext mask
;;; nil - off (unmask mtext)

(setq ed (vl-remove-if
         '(lambda (x) (member (car x) '(90 63 421 45 441)))
         (entget ent)
      ) ;_ end of vl-remove-if
) ;_ end of setq
(if OnOFF
(setq ed (append ed
               '((90 . 3)
                  (63 . 9)
                  (421 . 13158600)
                  (45 . 1.01)
                  (441 . 6042092)
                  )
         ) ;_ end of append
) ;_ end of setq
(setq ed (append ed '((90 . 2))))
) ;_ end of if
(entmod ed)
(entupd ent)
)

VVA 发表于 2022-7-6 11:06:33

txt2mtxt-来自Express Tools
Lee Mac Text 2多行文字升级

mawelby 发表于 2022-7-6 11:12:09

谢谢，但是在运行lisp时出现以下错误：

; 错误：错误字符读取（八进制）：0

知道为什么吗？

VVA 发表于 2022-7-6 11:19:11

使用expample附着dwg文件

mawelby 发表于 2022-7-6 11:25:21

我认为dwg无关紧要。错误在于加载lisp，而不是运行lisp。很抱歉给您带来困惑。

这是命令行文本（t2m2.lsp是您在第一篇文章中编写的代码）：

命令：appload
t2m2.lsp已成功加载。
命令：；错误：错误字符读取（八进制）：0

VVA 发表于 2022-7-6 11:35:35

我认为您正在使用Autocad的中文版本。类似问题
我编辑#2（从评论中删除俄语文本）
现在可以了？

mawelby 发表于 2022-7-6 11:40:11

我想我已经删除了所有俄语文本，但在加载时仍然出现错误：

(defun c:t2m (/ sset count num en el mcontent bbox point1 point2 point3 point4 mwidth mheight mstyle njust mrotate nmtext ss)
(setvar "cmdecho" 0)
(setq sset (ai_aselect))
(if (null sset)
(progn
(princ "\nNo objects selected.")
(exit)
)
)
(setq count 0 ss (ssadd))
(while (ssname sset COUNT)
(setq EN (ssname sset COUNT))
(setq EL (entget EN))
(if (= (cdr (assoc 0 EL)) "TEXT")
(progn
(setq mcontent (cons '1 (strcase (cdr (assoc 1 el)))))
(setq bbox (acet-geom-textbox EL 0.1))
(setq point1 (car bbox))
(setq point2 (cadr bbox))
(setq point3 (cadr (cdr bbox)))
(setq point4 (cadr (cdr (cdr bbox))))
(setq mwidth (cons '41 (distance point1 point2)))
(setq mheight (cons '40 (cdr (assoc 40 el))))
(setq mstyle (cons '7 (cdr (assoc 7 el))))
(setq nspace (cons '410 (cdr (assoc 410 EL))))
(setq minsert (cons '10 (cdr (assoc 10 EL))))
(cond
((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 1)));JY
((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 2)));JU
((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 3)));JI
((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 7)));JN
((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 7)));JN
((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 6)));JK
((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
((and (= (cdr (assoc 72 el)) 4)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 7)));JN
((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 ));JM
((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 9)));J,
((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
)
(setq mrotate (cons '50 (cdr (assoc 50 el))))
(setq nmtext (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(67 . 0) nspace '(8 . "TEXT") '(100 . "AcDbMText") minsert njust mheight mwidth mstyle mcontent mrotate))
(ssadd
                              (mip-mtext-mask (entmakex nmtext) t)
                              ss
                              )
(entdel en)
(setq count (+ count 1))
)
(setq count (+ count 1))
)
)
(if (> (sslength ss) 0)(command "_draworder" ss "" "_F"))
(setvar "cmdecho" 1)(princ)
)
(defun mip-mtext-mask (ent OnOff / ed)
;;; ent -mtext ename
;;; OnOff - t - on mtext mask
;;; nil - off (unmask mtext)

(setq ed (vl-remove-if
         '(lambda (x) (member (car x) '(90 63 421 45 441)))
         (entget ent)
      ) ;_ end of vl-remove-if
) ;_ end of setq
(if OnOFF
;;;
(setq ed (append ed
               '((90 . 3)
                  (63 . 9)
                  (421 . 13158600)
                  (45 . 1.01)
                  (441 . 6042092)
                  )
         ) ;_ end of append
) ;_ end of setq
(setq ed (append ed '((90 . 2))))
) ;_ end of if
(entmod ed)
(entupd ent)
)

VVA 发表于 2022-7-6 11:51:40

我不知道。这个代码适合我。我做了一些改变。尝试新版本。

(defun c:t2m (/    sset count num    en    el
         mcontent bbox point1 point2 point3 point4
         mwidth mheightmstyle njust mrotatenmtext
         ss
         )
(vl-load-com)
(setvar "cmdecho" 0)
(if (setq sset (ssget "_:L" '((0 . "TEXT"))))
(progn
(setq count 0
   ss (ssadd)
) ;_ end of setq
(while (ssname sset COUNT)
(setq EN (ssname sset COUNT))
(setq EL (entget EN))
(if (= (cdr (assoc 0 EL)) "TEXT")
(progn
   (setq mcontent (cons '1 (strcase (cdr (assoc 1 el)))))
   (setq EL (subst mcontent(assoc 1 EL) EL))
   (setq bbox (acet-geom-textbox EL 0.1))
   (setq point1 (car bbox))
   (setq point2 (cadr bbox))
   (setq point3 (cadr (cdr bbox)))
   (setq point4 (cadr (cdr (cdr bbox))))
   (setq mwidth (cons '41 (distance point1 point2)))
   (setq mheight (cons '40 (cdr (assoc 40 el))))
   (setq mstyle (cons '7 (cdr (assoc 7 el))))
   (setq nspace (cons '410 (cdr (assoc 410 EL))))
   (setq minsert (cons '10 (cdr (assoc 10 EL))))
   (cond
      ((and (= (cdr (assoc 72 el)) 0) (= (cdr (assoc 73 el)) 3))
      (setq NJUST (cons '71 1))
      )                                     ;JY
      ((and (= (cdr (assoc 72 el)) 1) (= (cdr (assoc 73 el)) 3))
      (setq NJUST (cons '71 2))
      )                                     ;JU
      ((and (= (cdr (assoc 72 el)) 2) (= (cdr (assoc 73 el)) 3))
      (setq NJUST (cons '71 3))
      )                                     ;JI
      ((and (= (cdr (assoc 72 el)) 0) (= (cdr (assoc 73 el)) 2))
      (setq NJUST (cons '71 7))
      )                                     ;JN
      ((and (= (cdr (assoc 72 el)) 1) (= (cdr (assoc 73 el)) 2))
      (setq NJUST (cons '71 7))
      )                                     ;JN
      ((and (= (cdr (assoc 72 el)) 2) (= (cdr (assoc 73 el)) 2))
      (setq NJUST (cons '71 6))
      )                                     ;JK
      ((and (= (cdr (assoc 72 el)) 0) (= (cdr (assoc 73 el)) 0))
      (setq NJUST (cons '71 7))
      )                                     ;JN
      ((and (= (cdr (assoc 72 el)) 4) (= (cdr (assoc 73 el)) 0))
      (setq NJUST (cons '71 7))
      )                                     ;JN
      ((and (= (cdr (assoc 72 el)) 0) (= (cdr (assoc 73 el)) 1))
      (setq NJUST (cons '71 7))
      )                                     ;JN
      ((and (= (cdr (assoc 72 el)) 1) (= (cdr (assoc 73 el)) 0))
      (setq NJUST (cons '71 7))
      )                                     ;JN
      ((and (= (cdr (assoc 72 el)) 1) (= (cdr (assoc 73 el)) 1))
      (setq NJUST (cons '71 )
      )                                     ;JM
      ((and (= (cdr (assoc 72 el)) 2) (= (cdr (assoc 73 el)) 1))
      (setq NJUST (cons '71 9))
      )                                     ;J,
      ((and (= (cdr (assoc 72 el)) 2) (= (cdr (assoc 73 el)) 0))
      (setq NJUST (cons '71 7))
      )                                     ;JN
   ) ;_ end of cond
   (setq mrotate (cons '50 (cdr (assoc 50 el))))
   (setq nmtext (list '(0 . "MTEXT") '(100 . "AcDbEntity")
                     '(67 . 0)    nspace
                     '(8 . "TEXT") '(100 . "AcDbMText")
                     minsert       njust
                     mheight       mwidth
                     mstyle       mcontent
                     mrotate
                     ) ;_ end of list
   ) ;_ end of setq
   (vla-put-backgroundfill
      (vlax-ename->vla-object (entmakex nmtext))
      :vlax-true
   ) ;_ end of vla-put-BackgroundFill
   (ssadd (entlast) ss)
   (entdel en)
   (setq count (+ count 1))
) ;_ end of progn
(setq count (+ count 1))
) ;_ end of if
) ;_ end of while
(if (> (sslength ss) 0)
(command "_draworder" ss "" "_F")
) ;_ end of if
)
(princ "\nNo objects selected.")
)
(setvar "cmdecho" 1)
(princ)
) ;_ end of defun

mawelby 发表于 2022-7-6 11:56:33

似乎正在工作。非常感谢你的帮助。

页: [1]

乐筑天下's Archiver

文字到多行文字lisp-添加backgr