我需要lisp那分割的文本。

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

我英语不好。。所以
我附上了文件。你可以轻松理解。。
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

copy

(defun c:test  ( / Text obj [color=blue]objent[/color] 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 [color=blue]objent[/color] (entget obj))
     (eq (cdr (assoc 0 [color=blue]objent[/color])) "TEXT")
     (setq ht (cdr (assoc 40 [color=blue]objent[/color])))
     (setq str
                (vl-remove-if
                      '(lambda (y)
                             (eq " "
                                 (chr y)))
                      (vl-string->list (cdr (assoc 1 [color=blue]objent[/color])))))
     [color=blue](progn
           (vla-GetBoundingBox (vlax-ename->vla-object obj) 'a 'b)
           (setq ptList (list
                              (setq Pt
                                         (vlax-safearray->list a))
                              )))
[/color]      (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))
      [color=blue](entdel obj)
[/color]       )
            )
           )
     (princ)
     )

这是我能得到的。

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

你错过了一个

copy

(vl-load-com)

。我觉得不错。失败的一件事是，如果旋转数据文本，则单独的文本组件无法保持其方向/位置。

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

希望你不介意pBe

我确实喜欢写它。

copy


(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

好点子丁克

copy

(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那分割的文本。

发表回复

精选推荐