对齐引线lisp
我的Lisp程序。但这个Lisp程序只适用于3点引线。
这个lisp能同时适用于2点引线和3点引线吗？？
请帮帮我。
;;; aligns the landings of selected 3 point leaders to a picked point or selection of leader
;;; and makes landing horizontal (if not already)
;;; https://www.theswamp.org/
(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>: ")
)
)
("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=
Your Code Here
这次我给你修好了。 您知道MLEADERALIGN命令吗？ 您好，您有什么方法可以对齐相同角度的引线，因为我的工作需要对齐300多个引线作为绘图的相同角度
页:
[1]