只为画图提升一点效率,送给大家一个lisp源代码
feng582304
feng582304 Lv.2
2008年03月23日 18:41:54
只看楼主

下面程序是本人编写,有绝对版权,有兴趣就拿去用,但请不要抄袭!!!!!!;------------------------------------------------------------------画楼梯;(defun c:pl0( / w0 h0 v0 v1 n nn1 nn2 o n2 mc w1 h1 tr k phh phh1 k0 o2 phw )(setq w0 (getdist "\n请输入踏步宽度/参考宽度<300>:"))

下面程序是本人编写,有绝对版权,有兴趣就拿去用,但请不要抄袭!!!!!!


;------------------------------------------------------------------画楼梯;
(defun c:pl0( / w0 h0 v0 v1 n nn1 nn2 o n2 mc w1 h1 tr k phh phh1 k0 o2 phw )
(setq w0 (getdist "\n请输入踏步宽度/参考宽度<300>:"))
(if (null w0) (setq w0 300))
(setq h0 (getdist "\n请输入踏步高度/参考单跑总高度 <160>:"))
(if (null h0) (setq h0 160))
(setq v0 (getreal "\n请输入楼梯板厚度/参考厚度 <100>:"))
(if (null v0) (setq v0 100))
(setq phh (getint "\n请输入平台高度<100>:"))
(if (null phh)(setq phh 100))
(setq tr t)
(while tr
(setq n (getint "\n请输入踏步级数:"))
(if n (setq tr nil))
)
(setq mc (getreal "\n请输入楼梯完成面厚度: <25>:"))
(if (null mc) (setq mc 25))
(setq n2 (+ (* n 2) 1))
(if (> h0 300) (setq h0 (/ h0 n)))
(setq h0 (float h0))
(setq w0 (float w0))
(setq o (getpoint "\n选择基点:"))
(while (/= n 0)
(setq v1 (* (/ (sqrt (+ (* w0 w0) (* h0 h0))) w0) v0))
(if (null k)
(progn
(setq o1 (getpoint "\n请选择在基点的左边或右边:"))
(if (> (car o) (car o1)) (setq k 1) (setq k 0))
)
(if (= k 1) (setq k 0) (setq k 1))
)
(setq nn1 (getint "\n请输入梯段步数:"))
(if (>= nn1 n) (setq nn1 n))
(setq n (- n nn1))
(setq o2 (pl00 w0 h0 nn1 n2 v1 o k phh mc 1 nil ))
(if (/= mc 0)
(progn
(setq v1 (+ v1 mc (* (/ h0 w0) mc) (* (/ (sqrt (+ (* w0 w0) (* h0 h0))) w0) mc)))
(if (= k 0)
(setq w1 (- (car o) mc))
(setq w1 (+ (car o) mc))
)
(setq h1 (+ (cadr o) mc))
(setq o (list w1 h1))
(setq phh1 (+ phh (* 2 mc)))
(setq phw (+ (cadr o2) (* 2 mc)))
(pl00 w0 h0 nn1 n2 v1 o k phh1 mc 0 phw)
))
(setq o (car o2))
)
(princ)
)
(defun pl00 ( w0 h0 n n2 v1 o k phh mc wcm phw / m w1 h1 txt txt1 txt2 li pp pj lw li0 ltlw ltlh )
(if (= wcm 1) (setq ltlw 200) (setq ltlw (+ 200 (* 2 mc))))
(if (= wcm 1) (setq ltlh 400) (setq ltlh (+ 400 (* 2 mc))))
(setq w1 (car o))
(setq h1 (cadr o))
(setq w2 w1)
(setq h2 h1)
(setq m 0)
(setq txt ’((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline")))
(setq txt2 (cons 90 n2))
(setq txt (append txt (list txt2) (list (list 10 w2 h2))))
(while (<= m (- n 1))
(setq h2 (+ h1 h0))
(setq txt1 (list 10 w2 h2))
(setq txt (append txt (list txt1)))
(if (= m (- n 1)) (progn (entmake txt) (setq li (list w2 h2))))
(setq h1 h2)
(if (= k 0)
(setq w2 (+ w1 w0))
(setq w2 (- w1 w0))
)
(setq txt1 (list 10 w2 h2))
(setq txt (append txt (list txt1)))
(setq w1 w2)
(setq m (1+ m))
)
(if (null phw)
(setq phw (getdist li "\n输入平台宽度:")))
(setq li0 (list li phw))
(if (= k 0)
(setq phw (+ (car li) phw))
(setq phw (- (car li) phw))
)
(if (= k 0)
(setq lw (+ (car li) ltlw))
(setq lw (- (car li) ltlw))
)
(setq w1 (car o))
(setq h1 (cadr o))
(setq h1 (- h1 v1))
(setq h2 (- h2 v1))
(setq pj (inters (list w1 h1) (list w2 h2) li (list (car li) (- (cadr li) ltlh)) nil))
(setq txt1 (list 10 w1 h1))
(setq txt2 (append (list 11) pj))
(setq txt (append ’((0 . "LINE")) (list txt1) (list txt2)))
(entmake txt)
(setq txt (append ’((0 . "LINE")) (list (append (list 10) pj)) (list (list 11 (car li) (- (cadr li) ltlh)))))
(entmake txt)
(setq txt (append ’((0 . "LINE")) (list (list 10 (car li) (- (cadr li) ltlh))) (list (list 11 lw (- (cadr li) ltlh)))))
(entmake txt)
(setq txt (append ’((0 . "LINE")) (list (list 10 lw (- (cadr li) ltlh))) (list (list 11 lw (- (cadr li) phh)))))
(entmake txt)
(setq txt (append ’((0 . "LINE")) (list (list 11 lw (- (cadr li) ltlh))) (list (list 11 lw phw))))
(entmake txt)
(setq txt (append ’((0 . "LINE")) (list (list 10 (car li) (cadr li))) (list (list 11 phw (cadr li)))))
(entmake txt)
(setq txt (append ’((0 . "LINE")) (list (list 10 lw (- (cadr li) phh))) (list (list 11 phw (- (cadr li) phh)))))
(entmake txt)
(setq txt (append ’((0 . "LINE")) (list (list 10 phw (cadr li))) (list (list 11 phw (- (cadr li) phh)))))
(entmake txt)
li0
)
免费打赏
feng582304
2008年03月23日 18:44:40
2楼
本程序用的创建方式是entmod,本来是想用vla-add来创建,但已经是编好了的,就不想去改了,就这个程序来说,这两种方式速度都差不多!
回复

相关推荐

APP内打开