可能是这样的：
- (defun c:toLeader (/ lst2pt ENT PTS TXT TYP)
- (vl-load-com) ;; Lee Mac ~ 24.02.10
- (defun lst2pt (lst flag)
- (if lst
- (cons (list (car lst) (cadr lst) (if flag (caddr lst) 0.0))
- (lst2pt (if flag (cdddr lst) (cddr lst)) flag))))
- (setq *doc (cond (*doc) ((vla-get-ActiveDocument
- (vlax-get-acad-object)))))
- (while
- (progn
- (setq ent (car (entsel "\nSelect Polyline for Leader: ")))
- (cond ( (eq 'ENAME (type ent))
- (if (wcmatch (setq typ (cdr (assoc 0 (entget ent)))) "*POLYLINE")
- (progn
- (setq pts
- (lst2pt
- (vlax-get
- (vlax-ename->vla-object ent) 'Coordinates)
- (if (eq "POLYLINE" typ) t nil)))
- (while
- (progn
- (setq txt (car (entsel "\nSelect Text for Leader: ")))
- (cond ( (eq 'ENAME (type txt))
- (if (eq "MTEXT" (cdr (assoc 0 (entget txt))))
- (progn
-
- (vla-AddLeader
-
- (if (zerop (vla-get-ActiveSpace *doc))
- (if (eq :vlax-true (vla-get-mspace *doc))
- (vla-get-ModelSpace *doc)
- (vla-get-PaperSpace *doc))
- (vla-get-ModelSpace *doc))
-
- (variant
- (vlax-safearray-fill
- (safearray vlax-vbDouble
- (cons 0 (1- (* 3 (length pts)))))
- (apply (function append) pts)))
-
- (vlax-ename->vla-object txt)
-
- acLineWithArrow)
- (entdel ent))
- (princ "\n** Object Must be MText **")))))))
-
- (princ "\n** Object Must be a *Polyline **"))))))
- (princ))
-
| 
置顶卡
