[编程交流] 对齐引线lisp

;;; aligns the landings of selected 3 point leaders to a picked point or selection of leader
;;; and makes landing horizontal (if not already)
;;; [url]https://www.theswamp.org/[/url]
(defun c:DD (/ c# crds doc e ins newpt obj ss txt x y sel)
 (vl-load-com)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (initget 0 "Leader PickPoint")
 (if (= (cond ((getkword
                 (strcat "\n Align by [Leader/PickPoint] <Leader>: ")
               )
              )
              ("Leader")
        )
        "Leader"
     )
   (and (setq e (car (entsel "\nSelect leader for alignment: ")))
        (setq x (cadr (assoc 10 (reverse (entget e)))))
   )
   (setq x (car (getpoint "\nSelect point for alignment: ")))
 )
 (if (and x (setq ss (ssget '((0 . "leader")))))
   (progn (vla-endundomark doc)
          (vla-startundomark doc)
          (foreach l (vl-remove e
                                (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                     )
            (setq obj  (vlax-ename->vla-object l)
                  crds (vlax-get obj 'coordinates)
                  c#   (length crds)
            )
            (if (and (= c# 9) ;if leader has 3 points and /= x coord
                     (not (equal x (nth (- c# 3) crds) 0.0001))
                )
              (progn (setq y     (nth (- c# 5) crds) ;new y coord to ensure flat landing
                           newpt (list x y (nth (1- c#) crds))
                     )
                     (vlax-put obj
                               'coordinates
                               (append (reverse (cdddr (reverse crds))) newpt)
                     )
                     (vla-update obj)
                     (and (setq txt (vl-catch-all-apply ;has text attached to leader
                                      'vlax-ename->vla-object
                                      (list (cdr (assoc 340 (entget l))))
                                    )
                          )
                          (not (vl-catch-all-error-p txt)) ;check for invalid ename
                          (setq ins (vlax-get txt 'insertionpoint))
                          (vlax-put txt
                                    'insertionpoint
                                    (polar (list x (cadr ins) (caddr ins))
                                           (if (> x (nth (- c# 3) crds))
                                             0.
                                             pi
                                           )
                                           (if (zerop (getvar 'tilemode))
                                             (vla-get-textgap obj)
                                             (* (getvar 'dimscale) (vla-get-textgap obj))
                                           )
                                    )
                          )
                          (vla-update txt)
                     )
              )
            )
          )
          (vla-endundomark doc)
   )
 )
 (princ)
)

Your Code Here[/NOPARSE]

Your Code Here