将文本项移动到（偏移量

Simon1976 · 发表于 2022-7-5 17:49:05

我一直在编写一个lisp，将文本项移动到（偏移量）保留文本项X值的最近行。
灵感：
在电缆图上工作时，文本项（由其他人）放置在离他们应该参考的线路（电缆）太远的地方
方法：
1）选择文字和行项目
2）分为两个不同的选择集
3）求出从直线的Y值到每个文本项的XY坐标的垂直距离，求出最小di
站姿到最近的行，然后将文本项移动到最近行上方/下方1mm
笔记：
a）无论是assoc 10还是assoc 11都可以完成这些线路——它们都是水平的
b）如果我把每一行都“拼凑”起来，然后把文本拼凑起来，那就很容易了——但我想做的是enmass操作
下面的代码适用于行上方的选定文本项。但不是下面这些。考虑到这一点，我决定使用lambda表达式中的函数距离重新编写lisp，以保持值为正（因此找到最小距离），当这些问题开始时。。。

请你们中的一个天才（genii？）帮个忙？上图显示的是，下图是预期结果

-西蒙

Tharwat · 发表于 2022-7-5 17:54:38

嗨，西蒙，

请尝试以下程序并让我知道：

copy


(defun c:test  (/ sel int obj lst txt srt p pt c l e)
 ;;====================================================;;
 ;; Author: Tharwat Al Shoufi. Date: 10.Apr.2016    ;;
 ;; move single text objects to nearest line with 1.0    ;;
 ;; unit away on Y Axe.                ;;
 ;;====================================================;;
 (if (setq sel (ssget "_:L" '((0 . "LINE,TEXT"))))
   (repeat (setq int (sslength sel))
     (if (eq "LINE" (cdr (assoc 0 (entget (setq obj (ssname sel (setq int (1- int))))))))
       (setq lst (cons obj lst))
       (setq txt (cons obj txt))
       )
     )
   )
 (if (and lst txt)
   (mapcar '(lambda (xt)
     (setq l nil
           e (entget xt)
           p (cdr (assoc 10 e))
           )
     (mapcar '(lambda (n)
                (setq c (vlax-curve-getclosestpointto n p)
                      l (cons (list (distance c p) c) l)
                      )
                )
             lst)
              (setq srt (vl-sort l '(lambda (j k) (< (car j) (car k)))))
              (if (< (cadr (cadar srt)) (cadr p))
                (setq pt (polar (cadar srt) (* pi 0.5) 1.0))
                (setq pt (polar (cadar srt) (* pi 1.5) (1+ (cdr (assoc 40 e)))))
                )
              (entmod (subst (cons 10 pt)
                             (assoc 10 e)
                             e))
              )
           txt
           )
   )
 (princ)
 )(vl-load-com)