|
(defun *error*(st)
(if (and (/= st "Function cancelled")
(/= st "quit / exit abort")
)
(princ (strcat "错误: " st))
)
(setq *error* old_err)
(princ)
) (defun sort (l / lt ltem vmax vmin l1 l2 l3
lt0 ltem0 ltem1 l30 vmax0 vmin0 l10 l20)
(setq ltem (mapcar 'car l) ;ltem : 取出l的第一项形成的表
vmin (1- (apply 'min ltem)) ;vmin : 是一个比ltem中最小的数还小的数
)
(while (< vmin (setq vmax (apply 'max ltem))) ;从ltem中取出最大值
(setq l1 l l3 nil ltem (subst vmin vmax ltem)) ;去掉最大值
(while (setq l2 (assoc vmax l1)) ;取出最大值所对应的项
(setq l1 (cdr (member l2 l1))) ;处理相同的值
(setq l3 (cons l2 l3))
)
(progn
(setq ltem0 (mapcar 'cadr l3)
ltem1 (mapcar 'car l3)
l30 (mapcar 'cdr l3)
vmin0 (1- (apply 'min ltem0))
)
(while (< vmin0 (setq vmax0 (apply 'max ltem0)))
(setq l10 l30 ltem0 (subst vmin0 vmax0 ltem0))
(while (setq l20 (assoc vmax0 l10))
(setq l10 (cdr (member l20 l10)))
(setq lt0 (cons l20 lt0))
)
)
(setq l3 (mapcar 'cons ltem1 lt0))
(setq l3 (reverse l3))
)
(setq lt (append l3 lt))
)
) (defun dxf (code en)
(cdr (assoc code en))
) (defun pross (bp sp / tem ss n el ip lpt en pt en1 en2 en3 w dis ang
di el1 el2 el3 pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8)
(if (> (car bp) (car sp))
(setq tem bp bp sp sp tem)
)
(setq ss nil)
(if (setq ss (ssget "c" bp sp))
(progn
(setq n 0)
(repeat (sslength ss)
(setq el (entget (setq en (ssname ss n))))
(if (and (= (dxf 0 el) "LINE")
(or (= (dxf 8 el) "WALL") (= (dxf 8 el) "GWALL"))
(setq ip (inters bp sp (dxf 10 el) (dxf 11 el)))
) ; ip 交点
(progn
(setq lpt (cons ip lpt))
)
)
(setq n (1+ n))
) ; repeat 找出所有的交点并形成表lpt
(if (/= nil lpt) (setq lpt (sort lpt)))
)
)
(if (> (length lpt) 2) (princ "\n警告:墙线有重线或选中了三条以上的墙线 !"))
(if (< (length lpt) 2) (princ "\n警告:选中的墙线少于两条 !"))
(if (/= nil lpt)
(progn
(setq pt (car lpt))
(setq ss (ssget pt))
(setq en1 (ssname ss 0))
(setq pt (cadr lpt))
(setq ss nil)
(setq ss (ssget pt))
(setq en2 (ssname ss 0))
)
)
(setq en3 (car (entsel "\n选择左或下参考线(轴线和墙线均可)")))
(setq el1 (entget en1))
(setq el2 (entget en2))
(setq el3 (entget en3))
(setq ip nil)
(setq ip (inters (dxf 10 el1) (dxf 11 el1) (dxf 10 el3) (dxf 11 el3) nil)) (initget 6)
(if (= nil dd) (setq dd 360.0))
(setq dis (getdist ip (strcat "\n距参考点的距离 <" (rtos dd 2 0) ">:")))
(if (= nil dis) (setq dis dd))
(setq dd dis) (initget 6)
(if (= nil ww) (setq ww 900.0))
(setq w (getreal (strcat "\n门宽 <" (rtos ww 2 0) ">:")))
(if (= nil w) (setq w ww))
(setq ww w) (setq ang (angle (dxf 10 el1) (dxf 11 el1)))
(if (>= ang 3.14159265) (setq ang (- ang pi)))
(if (or (= ang pi) (= ang (* pi 2))) (setq ang 0))
(setq di (distance (dxf 10 el1) (inters (dxf 10 el1) (polar (dxf 10 el1) (+ ang (* pi 0.5)) 100) (dxf 10 el2) (dxf 11 el2) nil)))
(setq pt1 (polar ip ang dis))
(setq pt2 (polar pt1 ang w))
(command "break" en1 pt1 pt2)
(setq pt3 (polar pt1 (+ ang (* pi 1.5)) di))
(setq pt4 (polar pt3 ang w))
(command "break" en2 pt3 pt4)
(if (= (dxf 8 el) "GWALL")
(command "layer" "s" "gwall" "")
(command "layer" "s" "wall" "")
)
(command "line" pt1 pt3 "")
(command "line" pt2 pt4 "")
(command "layer" "s" "door" "")
(if (> w 1000)
(progn
(setq pt5 (polar pt1 (+ ang (* pi 1.5)) (/ di 2.0)))
(setq pt6 (polar pt5 (+ ang (* pi 0.25)) (/ w 2)))
(command "line" pt5 pt6 "")
(setq pt5 (polar pt5 ang w))
(setq pt6 (polar pt5 (+ ang (* pi 0.75)) (/ w 2)))
(command "line" pt5 pt6 "")
)
(progn
(setq pt5 (polar pt1 (+ ang (* pi 1.5)) (/ di 2.0)))
(setq pt6 (polar pt5 (+ ang (* pi 0.25)) w))
(command "line" pt5 pt6 "")
)
)
) ;;;==============================================
;;; main programm
;;;============================================== (defun C:door(/ bp sp)
(setq old_err *error*)
(setvar "CMDECHO" 0)
(setvar "BLIPMODE" 0)
(command "layer" "m" "door" "c" "g" "door" "")
(command "osnap" "non")
(setq bp (getpoint "\n第一点(注意:墙线应在第一点和第二点之间): "))
(if (= nil bp) (quit))
(if (= (getvar "orthomode") 0) (setvar "orthomode" 1))
(setq sp (getpoint bp "\n第二点: "))
(if (= nil sp) (quit))
(pross bp sp)
(princ)
)
| 
发表于 2009-11-22 18:02:00
置顶卡
变色卡
显身卡
发表于 2009-11-22 20:12:00
楼主