需要一个简单的lisp

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

有人能帮我吗

-抓住要点
-选择要移动到新位置的第一个文本
-选择第二个文本以移动到新位置

谢谢

编辑：重复。它的庞大计划

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

太好了谢谢

在工作时重复使用

copy

(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更改
但不起作用

copy

(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与参考对齐）：

copy

(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)
)