社区 › Auto Lisp › 我需要lisp那分割的文本。

Arin9916 发表于 2022-7-6 09:26:57

我需要lisp那分割的文本。

我英语不好。。所以
我附上了文件。你可以轻松理解。。
QQ。图纸

pBe 发表于 2022-7-6 09:37:37

试试这个
 
(defun c:test( / Text obj ht str ptList)
(vl-load-com)
   (defun Text(pt hgt wd str)
         (entmakex
               (list (cons 0 "TEXT")
                     (cons 10 pt)
                     (cons 40 hgt)
                     (cons 41 wd)
                     (cons 1 str))))
   (cond (
            (and
   (setq obj (car (entsel "\nSelect Text:")))
   (setq obj (entget obj))
   (eq (cdr (assoc 0 obj)) "TEXT")
   (setq ht (cdr (assoc 40 obj)))
   (setq str
                (vl-remove-if
                      '(lambda (y)
                           (eq " "
                                 (chr y)))
                      (vl-string->list (cdr (assoc 1 obj)))))
   (setq ptList (list
                        (setq Pt   (getpoint
                                       "\nPick point to place text:"))))
   (repeat (1- (length str))
         (setq ptList (cons
                              (setq pt (vl-list*
                                             (+ (* ht 1.5)
                                                (car pt))
                                             (cdr pt)))
                              ptList)))
   (mapcar '(lambda (k l)
                  (Text l (cdr (assoc 40 obj)) (cdr (assoc 41 obj))(chr k)))
             str
             (reverse ptList))
      )
            )
         )
   (princ)
   )

Arin9916 发表于 2022-7-6 09:46:41

谢谢PBe公司
 
lisp正在工作。但这和我的意图没什么不同。
 
我要分解原始文本。而这个Lisp程序就是改变原文的位置。。。。。
 
 
谢谢你关注我的问题。^

pBe 发表于 2022-7-6 09:53:20

 
 
(defun c:test( / Text obj objent ht str ptList)
   (defun Text(pt hgt wd str)
         (entmakex
               (list (cons 0 "TEXT")
                     (cons 10 pt)
                     (cons 40 hgt)
                     (cons 41 wd)
                     (cons 1 str))))
   (cond (
            (and
   (setq obj (car (entsel "\nSelect Text:")))
   (setq objent (entget obj))
   (eq (cdr (assoc 0 objent)) "TEXT")
   (setq ht (cdr (assoc 40 objent)))
   (setq str
                (vl-remove-if
                      '(lambda (y)
                           (eq " "
                                 (chr y)))
                      (vl-string->list (cdr (assoc 1 objent)))))
   (progn
         (vla-GetBoundingBox (vlax-ename->vla-object obj) 'a 'b)
         (setq ptList (list
                              (setq Pt
                                       (vlax-safearray->list a))
                              )))
      (repeat (1- (length str))
         (setq ptList (cons
                              (setq pt (vl-list*
                                             (+ (* ht 1.5)
                                                (car pt))
                                             (cdr pt)))
                              ptList)))
   (mapcar '(lambda (k l)
                  (Text l (cdr (assoc 40 objent)) (cdr (assoc 41 objent))(chr k)))
             str
             (reverse ptList))
      (entdel obj)
       )
            )
         )
   (princ)
   )
 
这是我能得到的。

Organic 发表于 2022-7-6 10:04:31

你错过了一个
(vl-load-com)。我觉得不错。失败的一件事是，如果旋转数据文本，则单独的文本组件无法保持其方向/位置。

Tharwat 发表于 2022-7-6 10:05:29

希望你不介意pBe
 
我确实喜欢写它。
 

(defun c:Test (/ i ss e spc lst p t1 hgt)
(setq i 0)
(if
   (and
   (setq ss (car (entsel "\n Select Text :")))
   (eq (cdr (assoc 0 (setq e (entget ss)))) "TEXT")
   )
    (progn
      (setq spc (* (cdr (assoc 40 e)) 1.5))
      (setq lst (vl-string->list (cdr (assoc 1 e))))
      (setq p (cdr (assoc 10 e)))
      (repeat
      (length lst)
         (setq t1 (chr (nth i lst)))
         (entmakex (list (cons 0 "TEXT")
                         (cons 10 p)
                         (cons 40 (setq hgt (cdr (assoc 40 e))))
                         (cons 1 t1)
                   )
         )
         (setq i (+ i 1)
               p (list (+ (car p) spc)
                     (cadr p)
               )
         )
      )
      (entdel ss)
    )
)
(princ)
)
Tharwat

Tharwat 发表于 2022-7-6 10:16:40

 
好点子丁克
 
(defun c:Test (/ i ss e spc lst p t1 hgt)
(setq i 0)
(if
   (and
   (setq ss (car (entsel "\n Select Text :")))
   (eq (cdr (assoc 0 (setq e (entget ss)))) "TEXT")
   )
    (progn
      (setq spc (* (cdr (assoc 40 e)) 1.5))
      (setq lst (vl-string->list (cdr (assoc 1 e))))
      (setq p (cdr (assoc 10 e)))
      (repeat
      (length lst)
         (setq t1 (chr (nth i lst)))
         (entmakex (list (cons 0 "TEXT")
                         (cons 10 p)
                         (cons 40 (setq hgt (cdr (assoc 40 e))))
                         (cons 1 t1)
                   )
         )
         (setq i (+ i 1)
               p (polar (list (+ (car p) spc)(cadr p))(cdr (assoc 50 e)) spc)
         )
      )
      (entdel ss)
    )
)
(princ)
)

塔瓦特

pBe 发表于 2022-7-6 10:22:22

 
这是正确的，此外还有一些因素需要考虑。与str上的空格数“”一样，如果原始文本对正不是中间中心，则更容易解决位置问题（这就是为什么我加入了boundingbox函数）和yes旋转。我写的是最小值，仅适用于某些条件（因此命令名测试）
 
感谢您对Dink87522的见解，也感谢tharwat。
 
编辑。请随意修改我的代码来解析旋转和位置，我想看看其他人会如何处理它

Arin9916 发表于 2022-7-6 10:30:55

谢谢大家。
这些lisp对我很有用。^

查看完整版本: 我需要lisp那分割的文本。