不管如何原创的就要奖励,对你的程序,我重写了下,希望对你学习Lisp有所帮助

- ;;找两已知点的中点
- (defun get_midpt (pt1 pt2)
- (list (/ (+ (car pt1) (car pt2)) 2.)
- (/ (+ (cadr pt1) (cadr pt2)) 2.)
- )
- )
- (defun c:ce (/ oldos oldlayer e dis el typ rad
- pcen nrad p1 p2 p3 p4 sp1 ep1 sp2
- ep2 pm1 pm2 an
- ) ;_局部变量一定要收集全,养成习惯
- (setq oldos (getvar "osmode")) ;_保存捕捉
- (setvar "osmode" 0) ;_取消捕捉
- (setq oldlayer (getvar "clayer")) ;_得到旧图层的名称
- ;;建立中心线层
- (command "layer" "n" "line_center"
- "c" "1" "line_center"
- "lt" " " "line_center"
- ""
- )
- (while (setq e (car (entsel "\n选取直线或圆: "))) ;_直接拾取实体,后面判断
- (if (not dis)
- (setq dis (getdist "\n延伸长度: "))
- ) ;_延伸长度只取一次
- (if (= dis nil)
- (setq dis 0.)
- )
- (setq el (entget e) ;_实体DXF列表
- typ (cdr (assoc 0 el)) ;_ 0 实体类型
- )
- (cond
- ((= typ "CIRCLE") ;_ 圆
- (setq rad (cdr (assoc 40 el));_圆心
- pcen (cdr (assoc 10 el));_半径
- nrad (+ rad dis)
- p1 (polar pcen 0. nrad)
- p2 (polar pcen pi nrad)
- p3 (polar pcen (* 0.5 pi) nrad)
- p4 (polar pcen (* 1.5 pi) nrad)
- )
- (setvar "clayer" "line_center") ;_转到中心线层
- (command "line" p2 p1 "") ;_画中心线
- (command "line" p3 p4 "")
- )
- ((= typ "LINE")
- (if (setq e2 (entsel "\n请选取另一已知线:")) ;_仅适合Offset的一组Line
- (progn
- (setq el2 (entget (car e2))
- sp1 (cdr (assoc 10 el)) ;_线一起点
- ep1 (cdr (assoc 11 el)) ;_线一终点
- sp2 (cdr (assoc 10 el2))
- ep2 (cdr (assoc 11 el2))
- pm1 (get_midpt sp1 sp2) ;_两起点间的中点
- pm2 (get_midpt ep1 ep2) ;_两终点间的中点
- an (angle sp1 ep1) ;_线角度
- p1 (polar pm1 (+ an pi) dis) ;_中心线由中点算起
- p2 (polar pm2 an dis)
- )
- (setvar "clayer" "line_center")
- (command "line" p1 p2 "")
- )
- )
- )
- (t)
- )
- )
- (setvar "clayer" oldlayer) ;_回到原来图层
- (setvar "osmode" oldos) ;_恢复捕捉
- (princ "\nok!")
- (princ)
- )
|