2007年6月30日 星期六

[轉貼]:材料表計算


(DEFUN C:clb()
(PRINT "http://p4.xdcad.net/forum/showthread.php?s=&threadid=81603")
(PRINT "BY sdlp")
(PRINT "材料表計算")
(setq v1 (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "units" 2 1 "" "" "" "") 
(PROMPT "請選擇需改動的數字")
(setq s1 (ssget '((0 . "text")) ))
(setq n (sslength s1))
(SETQ SS (GETREAL "1:倍數,2:求總和,3:加和,4:條件加和,5:列相乘" ))
(WHILE (= SS 1) 
 (CHT1 S1 N)
 (SETQ SS 7)
)
(WHILE (= SS 2) 
 (CHT2 S1 N)
 (SETQ SS 7)
)
(WHILE (= SS 3) 
 (CHT3 S1 N)
 (SETQ SS 7)
)
(WHILE (= SS 4) 
 (CHT4 S1 N)
 (SETQ SS 7)
)
(WHILE (= SS 5) 
 (CHT5 S1 N)
 (SETQ SS 7)
)
(setvar "cmdecho" v1)
)
 
(defun CHT1(S1, N)
(setq wid1 (getreal "請輸入文字的倍數: " )) 
(setq i 0)
(repeat n
 (setq e (entget (ssname s1 i )))
 (setq tt1 (cdr (assoc 1 e)))
 (setq tt2 (atof tt1))
 (setq tt3 (* tt2 wid1))
 
 (setq tt4  tt3)
 (setq tt5 (RTOS tt4))
 (setq t5 (cons 1 tt5))
 (setq e1 (subst t5 (assoc 1 e) e))
 (entmod e1)
 (setq i (+ i 1))
)
)
 
 
 

(defun CHT2(S1, N)
;;(setq wid1 (getreal "請輸入文字的倍數: " )) 
(setq i 0)
(SETQ SS 0.00)
(repeat n
 (setq e (entget (ssname s1 i )))
 (setq tt1 (cdr (assoc 1 e)))
 (setq tt2 (atof tt1))
 (SETQ SS (+ SS TT2))
 (setq i (+ i 1))
)
(PRINT SS)
)
 
(defun CHT3(S1, N)
(setq wid1 (getreal "請輸入文字的加數: " )) 
(setq i 0)
(repeat n
 (setq e (entget (ssname s1 i )))
 (setq tt1 (cdr (assoc 1 e)))
 (setq tt2 (atof tt1))
 (setq tt3 (+ tt2 wid1))
 (setq tt4 (FIX tt3))
 (setq tt5 (itoa tt4))
 (setq t5 (cons 1 tt5))
 (setq e1 (subst t5 (assoc 1 e) e))
 (entmod e1)
 (setq i (+ i 1))
)
)
 
(defun CHT4(S1, N)
(setq wid1 (getreal "請輸入數字的加數: " ))
(setq wid2 (getreal "請輸入數字的起始數: " )) 
(setq i 0)
(repeat n
 (setq e (entget (ssname s1 i )))
 (setq tt1 (cdr (assoc 1 e)))
 (setq tt2 (atof tt1))
 (WHILE (>= TT2 35)
 (setq tt3 (+ tt2 wid1))
 (setq tt4 (FIX tt3))
 (setq tt5 (itoa tt4))
 (setq t5 (cons 1 tt5))
 (setq e1 (subst t5 (assoc 1 e) e))
 (entmod e1)
 (SETQ TT2 19)
 )
 (setq i (+ i 1))
)
)
 
 
 
(defun CHT5(S1, N)
;;(command "units" 2 1 "" "" "" "")
(PROMPT "請選擇需被乘的一列數字")
(setq s2 (ssget '((0 . "text")) )) 
(setq i 0)
(repeat n
 (setq e (entget (ssname s1 i )))
 (setq tt1 (cdr (assoc 1 e)))
 (setq tt2 (atof tt1))
 (setq xx1 (assoc 10 e))
 (setq xy1  (caddr xx1))
 (setq xx1  (cadr xx1))
 
(setq j 0)
(setq liang 1e1000)
(setq deltx 1e1000)
(setq delty 1e1000)
(repeat n
 (setq ee (entget (ssname s2 j )))
 (setq xy (assoc 10 ee))
 (setq xy2  (caddr xy))
 (setq xx2 (cadr xy))
(while (< (abs (- xy2 xy1)) delty)
 (setq delty (abs (- xy2 xy1)))
 (setq liang (ATOF (cdr (assoc 1 ee))))
 (setq deltx (abs (- xx1 xx2)))
 (setq xy2 (+ delty  xy1))
 )
(setq j (+ j 1))
)
 

 (setq tt3 (* tt2 liang))
 (setq tt4  tt3)
 (setq tt5 (rtos tt4))
 (setq t5 (cons 1 tt5))
 (setq e (subst t5 (assoc 1 e) e))
 (setq xx1 (+ (* 2 deltx) xx1))
 (setq xy1 (caddr (assoc 10 e)) )
 (setq xy (list 10 xx1 xy1 0 ))
 (setq e2 (subst xy (assoc 10 e) e))
 (entmake e2)
 (setq i (+ i 1))
)
)
 
(PRINT "執行命令: clb")

沒有留言: