社区 › Auto Lisp › Lisp编辑多行文字

Grrr 发表于 2022-7-5 17:27:55

@罗伊，我快速浏览了一下你的代码。
我认为在ConvSort子函数中，应该按边界框的质心排序，而不是“插入点”。

warlock-993 发表于 2022-7-5 17:31:56

 
 
我会试试，然后再给你回复。。。谢谢

Roy_043 发表于 2022-7-5 17:33:24

@Grrr：我不认为这有什么不同，但当然，为什么不（代码更新）。

warlock-993 发表于 2022-7-5 17:39:16

@Roy_043:。。。非常感谢你的帮助。
有没有办法修改它以同时处理文本和多行文字？
再次感谢您的。。。我真的很感激

Roy_043 发表于 2022-7-5 17:41:21

再次更新代码。删除了对numberp的不必要调用：
(numberp (setq num (getint "\nStart nr.: ")))

warlock-993 发表于 2022-7-5 17:45:58

谢谢@roy
我知道了如何在文字和多行文字上使用它，再次感谢你的帮助

warlock-993 发表于 2022-7-5 17:49:25

@roy是否可以调整lisp，使MTEXT如下所示：
40B12@200-150[铃声]
44B12@200-151[铃声]
如果“@”前面的数字相同，lisp会用相同的数字重新编号，例如：
40B12@200-150[铃声]
44B12@200-151[铃声]
两个“@”前面的数字都是“12”，所以我需要在重新编号后变成这样：
40B12@200-100[铃声]
44B12@200-100[铃声]
我只需要对最后一个中有的mtext进行这种调整。
提前感谢

Roy_043 发表于 2022-7-5 17:51:22

@术士993：祝你好运吧：
(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
(if ss
   (repeat (setq i (sslength ss))
   (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
   )
)
)

(defun KGA_Geom_ObjectMiddle (obj / ptBL ptTR)
(vla-getboundingbox obj 'ptBL 'ptTR)
(mapcar
   '/
   (mapcar '+ (vlax-safearray->list ptBL) (vlax-safearray->list ptTR))
   '(2.0 2.0 2.0)
)
)

(defun ConvSort (objLst)
(mapcar
   '(lambda (i) (nth i objLst))
   (vl-sort-i
   (mapcar '(lambda (obj) (KGA_Geom_ObjectMiddle obj)) objLst)
   '(lambda (a b)
       (if (equal (cadr a) (cadr b) 1e- ; Equal Y.
         (< (car a) (car b))
         (> (cadr a) (cadr b))
       )
   )
   )
)
)

; (ConvStr "40 B12@200-150 " 123) => "40 B12@200-123 "
(defun ConvStr (str n / i)
(strcat
   (substr str 1 (setq i (1+ (vl-string-position 45 str)))) ; (ascii "-") => 45.
   (itoa n)
   (progn
   (setq str (substr str (1+ i)))
   (while (wcmatch (substr str 1 1) "#") (setq str (substr str 2)))
   str
   )
)
)

; (ConvRingNumGet "40 B12@200-150 ") => 12
(defun ConvRingNumGet (str / i j)
(if (setq i (vl-string-position 64 str i)) ; (ascii "@") => 64.
   (progn
   (setq j i)
   (while (and (/= j 0) (wcmatch (substr str j 1) "#"))
       (setq j (1- j))
   )
   (if (/= i j) (atoi (substr str (1+ j) (- i j))))
   )
)
)

(defun c:Conv ( / doc enm lyr mainNum ringNumLst ss strLst)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-endundomark doc)
(vla-startundomark doc)
(if
   (and
   (setq enm (car (entsel "\nEntity for layer: ")))
   (setq lyr (vla-get-layer (vlax-ename->vla-object enm)))
   (setq mainNum (getint "\nStart nr.: "))
   (setq mainNum (1- mainNum))
   (setq ss (ssget "_X" (list '(0 . "MTEXT,TEXT") (cons 8 lyr) '(1 . "*-#*"))))
   (setq ss (ConvSort (KGA_Conv_Pickset_To_ObjectList ss)))
   )
   (mapcar
   '(lambda (obj / ringNum str)
       (vla-put-textstring
         obj
         (cond
         ((cdr (assoc (setq str (vla-get-textstring obj)) strLst)))
         ((wcmatch str "*#`@*-#*`")
             (if (assoc (setq ringNum (ConvRingNumGet str)) ringNumLst)
               (cdar (setq strLst (cons (cons str (ConvStr str (cdr (assoc ringNum ringNumLst)))) strLst)))
               (progn
               (setq ringNumLst (cons (cons ringNum (setq mainNum (1+ mainNum))) ringNumLst))
               (cdar (setq strLst (cons (cons str (ConvStr str mainNum)) strLst)))
               )
             )
         )
         ((cdar (setq strLst (cons (cons str (ConvStr str (setq mainNum (1+ mainNum)))) strLst))))
         )
       )
   )
   ss
   )
)
(vla-endundomark doc)
(princ)
)

warlock-993 发表于 2022-7-5 17:56:21

非常感谢@罗伊。。。你是救世主

查看完整版本: Lisp编辑多行文字