搜索lisp关于添加te

veteranus · 发表于 2022-7-5 16:50:01

嗨，我有两条短信。

我只想选择这些文本，并排创建表格。

这样地：

谢谢你们的帮助。

Lee Mac · 发表于 2022-7-5 17:04:31

使用现有代码提供解决方案：您可以复制表，然后使用此程序用所需的文本填充它。

veteranus · 发表于 2022-7-5 17:12:15

李安装了你的程序，但没有解决我的问题，请帮助。。。

veteranus · 发表于 2022-7-5 17:19:49

这属于你，猜猜看，但你需要这些数字。。。

;; 文本到表格-Lee Mac
;; 生成包含选定文字/多行文字内容的AutoCAD表格对象。

（定义c:text2table（/enx idx ins lst sel）
（if（和（setq sel（ssget’（（0。“TEXT，MTEXT”））））
（setq ins（getpoint“\n为表指定点：”）
)
（程序
（重复（setq idx（sslength sel））
（setq enx（entget（ssname sel（setq idx（1-idx））））
lst（cons（列表（LM:gettextstring enx）（cdr（assoc 10 enx）））lst）
)
)
（LM:addtable（vlax get属性（LM:acdoc）（if（=1（getvar'cvport））'paperspace'modelspace））
（trans ins 1 0）
无
（mapcar’（λ（x）（列表（x车）））
（vl sort lst’（λ（a b）（>（cadadr a）（cadadr b）））
)
无
)
)
)
（普林斯）
)

;; 获取文本字符串-Lee Mac
;; 返回文字、多行文字、多重引线、维度和属性的文字内容

（定义LM:gettextstring（enx/enx itm str typ）
（setq typ（cdr（assoc 0 enx）））
（续）
（（wcmatch typ“TEXT，*DIMENSION”）
（cdr（assoc 1（反向enx）））
)
（（和（=“多引线”典型）
（=acmtextcontent（cdr（assoc 172（反向enx）））
)
（cdr（assoc 304 enx））
)
（（wcmatch typ“ATTRIB，MTEXT”）
（setq str（cdr（assoc 1（反向enx）））
（while（setq itm（assoc 3 enx））
（setq str（strcat（cdr itm）str）
enx（cdr（成员itm enx））
)
)
str公司
)
)
)

;; 添加表-Lee Mac
;; 在给定点生成一个表，用给定数据和可选标题填充。
;; spc-[vla]vla块对象
;; ins-[lst]表格的WCS插入点
;; ttl-[str][可选]表格标题
;; lst-[lst]表格单元格数据的矩阵列表
;; eqc-[bol]如果T，则列的宽度相等
;; 返回：[vla]vla表对象

（定义LM：添加表（spc ins ttl lst eqc/dif hgt i j obj stn sty wid）
（setq sty）
（vlax ename->vla对象
（cdr
（协会-1）
（dictsearch（cdr（assoc-1（dictsearch（namedobjdict）“acad\u tablestyle”））
（getvar’ctablestyle）
)
)
)
)
)
（setq hgt（vla gettextheight sty acdatarow））
（if（LM:annotative-p（setq stn（vla gettextstyle sty acdatarow）））
（setq hgt（/hgt（cond（（getvar’cannoscalevalue））（1.0）））
)
（setq wid
（地图车
'（λ（col）
（应用“最大值”
（地图车
'（λ（str）
（（λ（盒）（if盒（+（*2.5 hgt）（（caadr盒）（caar盒）））0.0））
（文本框
（列表
（cons 01 str）
（cons 40 hgt）
（cons 07 stn）
)
)
)
)
col公司
)
)
)
（应用“mapcar（cons”列表lst））
)
)
（如果
（和ttl
(
（setq dif
(/
(-
（（λ（盒）（if盒（+（*2.5 hgt）（（caadr盒）（caar盒）））0.0））
（文本框
（列表
（cons 01 ttl）
（cons 40 hgt）
（cons 07 stn）
)
)
)
（应用“+wid）
)
（长度wid）
)
)
)
)
（setq wid（mapcar’（λ（x）（+x dif））wid））
)
（setq obj
（vla可添加spc
（vlax-3D点ins）
（1+（长度lst））
（长度（轿厢lst））
（*2.0 hgt）
（如果eqc
（应用“最大宽度”）
（/（应用'+wid）（浮点（长度（car lst）））
)
)
)
（vla put REGISTABLESUPPRESSED obj:vlax true）
（vla put stylename obj（getvar'ctablestyle））
（setq i-1）
（如果（空eqc）
（foreach col wid）
（vla setcolumnwidth obj（setq i（1+i））列）
)
)
（如果ttl
（程序
（vla settext obj 0 ttl）
（setq i 1）
)
（程序
（vla deleterows对象0 1）
（setq i 0）
)
)
（每行lst
（setq j 0）
（foreach val行
（vla settext obj i j val）
（setq j（1+j））
)
（setq i（1+i））
)
（vla put REGISTABLESUPPRESSED obj:vlax false）
obj公司
)

;; 注释性p-Lee Mac
;; 如果给定的Textstyle是注释性的，则返回T

（定义LM:annotative-p（sty）
（和（setq sty（tblobjname“style”sty））
（setq sty（cadr（assoc-3（entget sty’（“acadannotative”）））））
（=1（cdr（assoc 1070（反向sty）））
)
)

;; 活动文档-Lee Mac
;; 返回VLA活动文档对象

（定义LM:acdoc nil
（eval（list“defun”LM:acdoc“nil（vla get activedocument（vlax get acad object）））
（LM:acdoc）
)

（vl load com）（原理）

SLW210 · 发表于 2022-7-5 17:22:57

请阅读代码发布指南，并编辑代码以包含在代码标签中。[NOPARSE]

copy

Your Code Here[/NOPARSE]

=

copy

Your Code Here

BIGAL · 发表于 2022-7-5 17:34:08

你需要一个表吗？从编程的角度来看，一个块不会更好地工作。拾取text1 text2，然后自动静止插入块拾取点1 1 0 text1 text2全部完成。

只需要块的基本尺寸。发布线条和文字的dwg。自己动手吧，只需要一个具有2个属性的块。

copy


(defun c:tbox ( / t1 t2 pt)
(setq t1 (vla-get-textstring  (vlax-ename->vla-object  (car (entsel "Pick text 1 ")))))
(setq t2 (vla-get-textstring  (vlax-ename->vla-object  (car (entsel "Pick text 2 ")))))
(setq pt (getpoint "Pick point for label"))
(command "insert" "Tbox" pt 1 1 0 t1 t2)
)

Tharwat · 发表于 2022-7-5 17:36:13

你好
尝试以下代码，但您应该已经有了表格，能够将两个文本放置在第二行中；

copy


(defun c:txt2tbl (/ l s l tbl)
 ;; Tharwat - Date:28.Dec.2016        ;;
 (and
   (progn
     (while (and
              (/= 2 (length l))
              (princ
                (strcat
                  "\nPick"
                  (if l
                    " Second "
                    " First "
                    )
                  "text :"
                  )
                )
              (setq s (ssget "_+.:S:E" '((0 . "*TEXT"))))
              (setq l (cons (cdr (assoc 1 (entget (ssname s 0)))) l))
              )
      )
     (= 2 (length l))
     )
   (princ "\nPick a table :")
   (setq tbl (ssget "_+.:S:E:L" '((0 . "ACAD_TABLE"))))
   (setq tbl (vlax-ename->vla-object (ssname tbl 0)))
   (vl-every
     '(lambda (n) (< 1 n))
     (list (vla-get-rows tbl) (vla-get-columns tbl))
     )
   (mapcar '(lambda (s c) (vla-settext tbl 1 c s)) l '(0 1))
   )
 (princ)
 ) (vl-load-com)