 -
- ( defun c:wc( / hh p1 p2 p3 p4 pa pb pc pd w1 ww)
- (setvar "cmdecho" 0 )
- (setvar "blipmode" 0 )
- (setq pa (getpoint "请输入第一点"))
- (setq ww (getreal "\n请输入门洞宽度"))
- (setq hh (getreal "\n请输入门洞高度"))
- (setq w1 (getreal "\n请输入周边框宽度"))
- (setq pb (polar pa 0 ww))
- (setq pc (polar pb (/ pi 2) hh))
- (setq pd (polar pa (/ pi 2) hh))
- ;矩形四角点pa,pb,pc,pd
- (setq p1 (polar pa 0 w1))
- (setq p2 (polar pa 0 (- ww w1)))
- (setq p3 (polar p2 (/ pi 2) (- hh w1)))
- (setq p4 (polar p1 (/ pi 2) (- hh w1)))
- ;内四角点p1,p2,p3,p4
- (command "pline" pa pd pc pb p2 p3 p4 p1 "c")
- (command "line" p1 p2 "" )
- (command "zoom" "a" "")
- (setq en (entlast))
- ;取line (p1,p2)
- (setq txgd (getreal "通行高度"))
- (setq htgd (getreal "\n横套高度"))
- (setq pup(polar p1 (/ pi 2) txgd))
- (setq pup2(polar p1 (/ pi 2) (+ txgd htgd)))
- (command "copy" en "" p1 pup "")
- (command "copy" en "" p1 pup2 "")
- ;横套绘制
- (prin1)
- )
- (prompt "***********<< c:wc >>***********")
- (prin1)
|