[编程交流] 将多重引线文本对齐到ar

(defun c:foo (/ pts s)
 (if (setq s (ssget "_X" '((0 . "multileader"))))
   (foreach ml        (mapcar 'vlax-ename->vla-object (mapcar 'cadr (ssnamex s)))
     (setq pts (vlax-invoke ml 'getleaderlinevertices 0))
     (cond ((equal (car pts) (cadddr pts) 1e- (print "Vertical leader.."))
    ((< (car pts) (cadddr pts)) (vla-put-textjustify ml 1))
    ((vla-put-textjustify ml 3))
     )
   )
 )
 (princ)
)
(vl-load-com)

(defun C:test ( / SS i )
 (and 
   (setq SS (ssget "_:L" '((0 . "MULTILEADER"))))
   (repeat (setq i (sslength SS))
     (foo (ssname SS (setq i (1- i))))
   )
 )
 (princ)
)
(setq foo 
 (lambda ( e / e o L pts )
   
   (defun GroupByN ( n L / r )
     (repeat n (and L (setq r (cons (car L) r))) (setq L (cdr L)) r)
     (if L (cons (reverse r) (GroupByN n L)) (list (reverse r)))
   ); defun GroupByN
   
   (cond 
     (
       (and 
         ; (setq e (car (entsel "\nPick mleader: ")))
         (setq o (vlax-ename->vla-object e))
         (setq L (GroupByN 3 (vlax-invoke o 'GetLeaderLineVertices 0)))
         (setq pts (list (car L)(last L)))
       )
       (vl-some 
         (function
           (lambda ( x / xf yf al )
             (mapcar 'set '(xf yf al) x)
             (and
               (apply xf (append (mapcar 'car pts) (if (eq eq xf) (list 1e-1))))
               (apply yf (append (mapcar 'cadr pts) (if (eq eq yf) (list 1e-1))))
               (progn 
                 (vla-put-TextJustify o (eval al)) 
                 ; (alert (vl-symbol-name al)) 
                 T
               )
             )
           ); lambda
         ); function
         '(
           (eq > acAttachmentPointBottomCenter) ; OK
           (eq < acAttachmentPointTopCenter) ; OK 
           (< eq acAttachmentPointMiddleLeft) ; NOT
           (> eq acAttachmentPointMiddleRight) ; NOT
           (< < acAttachmentPointBottomLeft) ; OK
           (> < acAttachmentPointBottomRight) ; OK
           (< > acAttachmentPointTopLeft) ; OK
           (> > acAttachmentPointTopRight) ; OK
         ); list
       ); vl-some
     )
   ); cond
   (princ)
 ); lambda
); setq foo

(and 
 (setq p ((lambda (L) (list (car L) (cadr L) (caddr L))) (vlax-invoke (vlax-ename->vla-object (car (entsel))) 'GetLeaderLineVertices 0)))
 (entmakex (list (cons 0 "POINT") (cons 62 1) (cons 10 p)))
)