Question

求：cad二次开发lisp程序

求高手帮忙做一个lisp程序，意图如下：
在CAD模型里面画一条直线，沿直线左右分布很多圆，求能批量解决所有圆圆心到直线的垂直距离，得出的所有数值位于直线左边加“－”，右边加“＋”，然后导出Excel或记事本。

Answer 1

;;;;编于2010 5 31
(defun c:ggyy()
(setvar "cmdecho" 0)
(setq k (entsel "请选取直线："))
(setq kdata (entget (car k)))
(setq k1 (cdr (assoc 10 kdata)))
(setq k2 (cdr (assoc 11 kdata)))
(setq t1x (car k1) t1y (cadr k1) t1z (caddr k1))
(setq t2x (car k2) t2y (cadr k2) t2z (caddr k2))
(setq ang (angle k1 k2))
(setq ss (ssget "X" '((0 . "CIRCLE"))))
(setq n 0 sum1 0 sum2 0)
(setq gg (ssadd) ggs (ssadd))
(setq sn (sslength ss))
(setq ffn (getfiled "选取文件" "" "txt" 1))
(setq ff (open ffn "w"))
(repeat sn
(setq en (ssname ss n))
(pk en)
(setq n (1+ n))
)
(setq ff (open ffn "a"))
(princ "线左边-------------" ff)
(princ "\n" ff)
(princ "总数量" ff)
(princ ": " ff)
(princ sum1 ff)
(princ "\n" ff)
(close ff)
(ps gg)
(setq ff (open ffn "a"))
(princ "\n" ff)
(princ "线右边-------------" ff)
(princ "\n" ff)
(princ "总数量" ff)
(princ ": " ff)
(princ sum2 ff)
(princ "\n" ff)
(close ff)
(pss ggs)
(prin1)
)

(defun pk(ww)
(setq ty (entget ww))
(setq cen (cdr (assoc 10 ty)))
(setq cx (car cen) cy (cadr cen) cz (caddr cen))
(setq wy (xk cx)) m3
(if (> cy wy)
(progn
(setq sum1 (1+ sum1))
(setq gg (ssadd ww gg))
)
(progn
(setq sum2 (1+ sum2))
(setq ggs (ssadd ww ggs))
)
)
(prin1)
)

;;;;求直线方程y=ax+b；；；
(defun xk(x)
(setq a (/ (- t2y t1y) (- t2x t1x)))
(setq b (- t1y (* a t1x)))
(setq y (+ b (* a x)))
)
;;
(defun ps(gs)
(setq nn 0 ss1 (ssadd))
(setq gf (sslength gs))
(close ff)
(repeat gf
(setq en (ssname gs nn))
(setq tg (entget en))
(setq tr (cdr (assoc 40 tg)))
(setq cg (cdr (assoc 10 tg)))
(setq gx (car cg) gy (cadr cg) gz (caddr cg))
(setq angg (+ ang (/ pi 2)))
(setq pp (polar cg angg tr))
(setq s (inters pp cg k1 k2 nil))
(setq sk (distance s cg ))
(setq ff (open ffn "a"))
(princ "+" ff)
(princ sk ff)
(princ "\n" ff)
(close ff)
(setq nn (+ 1 nn))
)

(prin1)
)

(defun pss(gs)
(setq nn 0 ss1 (ssadd))
(setq gf (sslength gs))
(close ff)
(repeat gf
(setq en (ssname gs nn))
(setq tg (entget en))
(setq tr (cdr (assoc 40 tg)))
(setq cg (cdr (assoc 10 tg)))
(setq gx (car cg) gy (cadr cg) gz (caddr cg))
(setq angg (- ang (/ pi 2)))
(setq pp (polar cg angg tr))
(setq s (inters pp cg k1 k2 nil))
(setq sk (distance s cg ))
(setq ff (open ffn "a"))
(princ "-" ff)
(princ sk ff)
(princ "\n" ff)
(close ff)
(setq nn (+ 1 nn))
)

(prin1)
)