社区 › Auto Lisp › 需要一个简单的lisp

asos2000 发表于 2022-7-6 08:06:37

需要一个简单的lisp

有人能帮我吗
 
-抓住要点
-选择要移动到新位置的第一个文本
-选择第二个文本以移动到新位置
 
谢谢
 
编辑：重复。它的庞大计划

MSasu 发表于 2022-7-6 08:11:08

一种解决方案：
 
(defun C:MoveLabels( / thePoint label1st label2nd moveSet entList)
(while (and (setq thePoint (getpoint "\nInsertion point: "))
            (setq label1st (car (entsel))
                  label2nd (car (entsel))))
(progn
(foreach moveSet (list (list label1st 300.0   0.0)
                         (list label2nd 300.0 400.0))
(setq entList(entget (car moveSet)))
(entmod (subst (list '10 (+ (car thePoint) (cadr moveSet)) (+ (cadr thePoint) (caddr moveSet)) (caddr thePoint))
               (assoc 10 entList)
               entList))
)
)
)
(princ)
)
 
当做
米尔恰

asos2000 发表于 2022-7-6 08:16:24

 
太好了谢谢
 
在工作时重复使用
(defun C:MoveLabels( / thePoint label1st label2nd moveSet entList)
(while
(if (and (setq thePoint (getpoint "\nInsertion point: "))
         (setq label1st (car (entsel))
               label2nd (car (entsel))))
(progn
(foreach moveSet (list (list label1st 300.0   0.0)
                         (list label2nd 300.0 400.0))
(setq entList(entget (car moveSet)))
(entmod (subst (list '10 (+ (car thePoint) (cadr moveSet)) (+ (cadr thePoint) (caddr moveSet)) (caddr thePoint))
               (assoc 10 entList)
               entList))
)
)
)
)
(princ)
)

MSasu 发表于 2022-7-6 08:20:02

不客气！
已经注意到重复请求-您可以检查修订版。不过，你的零钱也可以。
 
当做
米尔恰

asos2000 发表于 2022-7-6 08:24:37

 
试图避免UCs更改
但不起作用
(defun C:Mll ( / thePoint label1st label2nd moveSet entList)
(while t
(if (and (setq thePoint (getpoint "\nInsertion point: "))
         (setq label1st (car (entsel))
               label2nd (car (entsel))))
(progn
   (setq thePoint (trans thePoint 1 0))
(foreach moveSet (list (list label1st 300.0   0.0)
                         (list label2nd 300.0 400.0))
(setq entList(entget (car moveSet)))
(entmod (subst (list '10 (+ (car thePoint) (cadr moveSet)) (+ (cadr thePoint) (caddr moveSet)) (caddr thePoint))
               (assoc 10 entList)
               entList))
)
)
)
)
(princ)
)

MSasu 发表于 2022-7-6 08:27:09

应在计算位移后转置点（假设UCS与参考对齐）：
 
(defun C:MoveLabels( / thePoint label1st label2nd moveSet entList)
(while (and (setq thePoint (getpoint "\nInsertion point: "))
            (setq label1st (car (entsel))
                  label2nd (car (entsel))))
(progn
(foreach moveSet (list (list label1st 300.0   0.0)
                         (list label2nd 300.0 400.0))
(setq entList(entget (car moveSet)))
(entmod (subst (cons '10 (trans (list (+ (car thePoint) (cadr moveSet)) (+ (cadr thePoint) (caddr moveSet)) (caddr thePoint)) 1 0))
               (assoc 10 entList)
               entList))
)
)
)
(princ)
)
 
当做
米尔恰

asos2000 发表于 2022-7-6 08:30:50

 
谢谢Mircea

MSasu 发表于 2022-7-6 08:33:05

只需使用我用红色（X）、蓝色（Y1）和绿色（Y2）着色的值来匹配您的情况。
 
问候，
米尔恰

antistar 发表于 2022-7-6 08:39:51

 
对不起，米尔恰，
我想我之前不是很清楚。
不希望选择点，而是选择多段线。
文本始终位于多段线的右下角。

Lee Mac 发表于 2022-7-6 08:41:13

只需选择右下角

查看完整版本: 需要一个简单的lisp