[轉貼]：材料表計算

(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")

[轉貼]：DSX AutoLayer

;;*********************************************************
;;;*********************************************************
(vl-load-com)
(defun get-item (collection item / result)
(cond
((not
(vl-catch-all-error-p
(setq result
(vl-catch-all-apply 'vla-item (list collection item))
)
)
)
result
)
)
)
(setq oAcad (vlax-get-acad-object) ; acadapplication object
oDoc (vla-get-activedocument oAcad) ; activedocument object
oLay (vla-get-layers oDoc) ; layers collection of activedocument
)
(defun rCmdLayer (reactor data / cmd)
(setq cmd (strcase (car data))) ; get command name
(cond
((wcmatch cmd "*HATCH") ;is the command "*hatch"?
(rCmdLayer-Setlayer "HATCH")
)
)
)
(defun rCmdLayer-SetLayer (name / lay)
(cond
((setq lay (get-item oLay name))
(if (= :vlax-True (vla-get-lock lay))
(progn
(setq $laylock :vlax-True)
(vla-put-lock lay :vlax-False)
)
)
(if (= :vlax-False
(vla-get-layeron lay)
(progn
(setq $layon :vlax-false)
(vla-put-layeron lay :vlax-true)
)
)
(if (= :vlax-True (vla-get-Freeze lay))
(progn
(setq $layfrz :vlax-true)
(vla-put-Freeze layobj :vlax-false)
)
)
(vla-put-activelayer aDoc lay)
)
)
)
)
(defun rCmdLayer-Restore (reactor data / data lay)
(setq cmd (strcase (car data))) ; get command name
)
;;;upon completion of command restores *layers* to previous state
(defun al:restore (reactor info / cmd layobj)
(setq cmd (car info))
(if
(and
*capslock*
(or
(wcmatch (strcase cmd)
"*LEADER,*QLEADER,*MTEXT,*TEXT,*DDEDIT,*ATTEDIT"
)
(and
(wcmatch
(strcase cmd)
"*DIM,*DIMLINEAR,*DIMALIGNED,*DIMORDINATE,*DIMRADIUS,*DIMDIAMETER,*DIMANGULAR,*DIMBASELINE,*DIMCONTINUE,*QDIM,*LEADER,*QLEADER,*MTEXT,*TEXT,*DDEDIT"
)
(= (vlax-variant-value (vla-getvariable *adocobj* "dimaso"))
0
)
)
)
)
(dos_capslock)
)
(if (< (vlax-variant-value (vla-getvariable *adocobj* "cmdactive"))
2
) ;test for transparent commands
(progn
(setq layobj (vla-get-ActiveLayer *adocobj*))
;get ActiveLayer object
(if offlay ; "hidden" layer noted as off (offlay not nil)
(vlax-put-property
(vla-item *layers*
(if (wcmatch (strcase (car info)) "*HATCH")
"Hidden"
"Hatch"
)
)
"LayerOn"
1
) ;turn "hidden" layer back on
) ;end if
(if
(and
clobj ; clayer objobject assigned to clobj in al:laystate (clobj not nil)
(not (equal clobj layobj)) ;if clayer object (clobj set in al:laystate) layer object
) ;end and
(vla-put-ActiveLayer *adocobj* clobj) ;sets layer current
) ;end if
(if layoff ; if the layer (layoff set in al:laystate) was noted as off (layoff not nil)
(vla-put-LayerOn layoff 0) ;turn it off again
) ;end if
(if layfreeze ; if layer (layfreeze set in al:laystate) was frozen (layfreeze not nil)
(vla-put-Freeze layfreeze 1) ;freeze it again
) ;end if
(if laylock ; if layer (laylock set in al:laystate) was locked (laylock not nil)
(vla-put-Lock laylock 1) ;Lock it again
) ;end if
(setq clobj nil
offlay nil
layoff nil
layfreeze nil
laylock nil
) ;set global variables to nil
) ;end progn
) ;end if
) ;end defun

;;;======================================================================
;;;disables commandEnded reactor to avoid errors when using "new" and "open"
;;;in SDI mode. The error is merely annoying and only appears at the command
;;;line as "error: no function definition: al:restore" when opening or creating
;;;a new drawing. The cause of the error is commandEnded reactor present form
;;;last dwg but LISP has not yet loaded the called function in a new or opened
;;;dwg. Furthermore, the reactor cannot be removed because it has already been
;;;activated and is waiting for the command to end. Therefore, the reactor must
;;;be rendered non-functional by changing its call to the LISP command "LIST".
(defun al:disable (reactor info / tdat)
(if
(= (vlax-variant-value (vla-getvariable *adocobj* "sdi")) 1)
;in SDI mode?
(vlr-reaction-set
(car (vlr-object
'(VLR-Command-reactor
nil
'((:VLR-commandWillStart . al:autolay)
(:VLR-commandEnded . al:restore)
(:VLR-commandCancelled . al:restore)
)
)
)
)
:VLR-commandEnded
'list
)
) ;end if
) ;end defun

;;;======================================================================
;;;Here's where we set up the reactors to do all this cool stuff
(vlr-set-notification
(vlr-manager
'(VLR-DWG-reactor nil '((:VLR-beginClose . al:disable)))
3
)
'active-document-only
)
(vlr-set-notification
(vlr-manager
'(VLR-Command-reactor
nil
'((:VLR-commandWillStart . al:autolay)
(:VLR-commandEnded . al:restore)
(:VLR-commandCancelled . al:restore)
)
)
3
)
'active-document-only
)


;;;======================================================================
;;;get rid of old reactor if present. The reactor will be present, because in
;;;SDI mode, it's associated namespace is not destroyed, but has the new drawing
;;;loaded into it. At the time this file is loaded, this reactor is either not
;;;present or has been rendered useless (in SDI mode) at the closing of the last
;;;dwg and is excess loaded code bulk and should be removed. The VLR-MANAGER
;;;provides an easy means of doing this.
(vlr-manager
'(VLR-Command-reactor
nil
'((:VLR-commandWillStart . al:autolay)
(:VLR-commandEnded . list)
(:VLR-commandCancelled . al:restore)
)
)
1
)
;;;======================================================================
(princ
"\nAutoLay V2.2 loaded. Type \"autolay\" or \"capslock\" to enable/disable."
)
(princ)

;;;======================================================================
;
Set up and installation instructions:
This is kind of an outline of the things you may need to edit to make this program work with your companies drafting standards.

The main body of autolay has the conditions that must be tested for to see if a layer needs to be switched to or created. It is also
where the layer name comes from. (al:laystate "Hatch" cmd) is the first such command (noted as cond 1) in the code to create or
switch to a layer, where "Hatch" is to be the actual name of the layer to be created. The conditions will probably be the most
difficult part to adapt to your companies drafting standards. Lets take a look at cond 6 for example:

(;cond 5
(wcmatch cmd "*TEXT");are you creating text?
(al:laystate "Text" cmd);make, thaw, turn on and make current "Text" layer as needed
);end cond 5

If the command (cmd) is "*text", then create or switch to a layer named "Text". You can have as many conds and *layers* as you
need. You can also add other parameters such as text style and/or size in different CONDS to put different text styles or sizes
on different *layers*. That would then look more like:

(;cond 6
(and
(wcmatch cmd "*TEXT");are you creating text?
(wcmatch tst "~SIMPLEX");is the current text style NOT "Simplex"*
(= tsz (* (getvar "dimscale") 0.0625));is this the current text size?
);end and
(al:laystate "Text" cmd);make, thaw, turn on and make current "Text" layer as needed
);end cond 6

The routine al:ltype is the one that decides what linetype is assigned to a layer (name). Similar is true for al:lweight and al:color.
Edit these to suit your companies drafting standards.

One more thing. If you use a different linetype source file (.lin file format) other than acad.lin or acadiso.lin, you will
have to edit in the name of the linetype file name in the al:mkLay routine.

To disable AutoLay[2.2].lsp, type "autolay" at the commond prompt.

This should be enough to get you going. Pick away, play around with it and learn from it until you get it to do what you want. I
already did the hard part of coding and testing.

Best Regards
Eric Schneider;

轉貼:http://publishblog.blogchina.com/blog/tb.b?diaryID=5753822

[轉貼]：兩個矢量的點積

 

;; ! Function : Computes the dot products of two vectors
;; !
;; ! Arguments: 'v1' - First vector
;; !            'v2' - Second Vector
;; !
;; ! Returns  : 'scl'  - The dot product of the two vectors which is a scalar
;; !                     value
;; ! Theory:    Say you have two vectors
;; !            A= ax i +  ay j + az k
;; !            B= bx i +  by j + bz k
;; !
;; ! then A . B = ax.bx + ay.by + az.bz
;; ! (C) 1999-2004, Four Dimension Technologies, Bangalore
;; ! e-mail   : rakesh.rao@4d-technologies.com
;; ! Web      : www.4d-technologies.com
;; ! ****************************************************************************
;; 兩個矢量的點積
(defun GE_VecDotProduct (v1 v2)
  (apply '+ (mapcar '* v1 v2))
)

 

[轉貼]：兩個矢量的點積

http://publishblog.blogchina.com/blog/tb.b?diaryID=5754891

張貼和修改

可以在張貼時使用快速鍵嗎？
Blogger 提供幾個用來編輯文章的快速鍵。
它們一定可以在 Internet Explorer 5.5+/Windows 和 Mozilla 系列
(1.6+ 及 Firefox0.9+) 上使用，而其他瀏覽器可能也適用。 這些快速鍵包括：

Ctrl + B = 粗體
Ctrl + I = 斜體
Ctrl + l = 引用文字 (Blockquote，僅限 HTML 模式)
Ctrl + Z = 復原
Ctrl + Y = 取消復原
Ctrl + Shift + A = 連結
Ctrl + Shift + P = 預覽
Ctrl + D = 儲存為草稿
Ctrl + S = 發佈文章

精采網址

Windows工具箱
http://www.wells.hk/ws_toolsneg.php

微軟-搜尋知識庫
http://support.microsoft.com/search/default.aspx?query=%E6%A9%8B%E6%8E%A5%E5%99%A8&catalog=LCID%3D1028&spi

d=&amp;qryWt=&mode=r&cus=False&x=6&y=9

BT之家-BT文化
http://bbs.btbbt.com/

線上檔存儲，擁有25G免費線上空間
http://amd.streamload.com/

免費上傳空間網址:
http://up-file.com/index.php
http://www.rapidupload.com/
http://shareit.ws/?page=upload
http://www.badongo.com/application/windows

[60G,只能上傳圖檔類型]
http://picsplace.to/upload.php
http://sv1.letmehost.com/

verycd互聯網
http://www.verycd.com/

貪婪大陸
http://share.greedland.net/cache_html/2/seeds/DESC/1.htm
http://share.greedland.net/cache_html/0/seeds/DESC/1.htm

AutoCAD Color Index RGB Equivalents

ASCII對照表

結婚前後

<結婚前> 往↓看：

 

他：太好了！ 期盼的日子終於來臨了！我都等不及了！

她：我可以後悔嗎？

他：不行，你甚至想都別想！

她：你愛我嗎？

他：當然！

她：你會背叛我嗎？

他：不會，你怎麼會有這種想法？

她：你可以吻我一下嗎？

他：當然，決不可能只有一下！

她：你有可能 打我嗎？

他：永遠不可能！

她：能相信你嗎？

 

<結婚後> 從下往上看↑

游泳自救方法

游泳自救方法

不會游泳嗎??? 沒關係 ~~~

至少要會漂浮自救

如何分辨病毒的 Mail

如何分辨病毒的 Mail

提醒大家注意！！

★如何分辨病毒的 Mail~

1,借此機會再提醒您，如何來遠避病毒的危害。

2,病毒的來源約可分為如下：

一 ,瘋狂的線上遊戲者，為竊取他人的密碼，搜刮通訊錄所施放的病毒。

二 ,工作枯燥的程式設計工程師，為了肯定自我，寫的病毒，讓人電腦中毒。

三 ,有一說電腦防毒軟體的設計者，故意在網路上施放病毒，讓大夥電腦都中毒，要不有誰願意去安裝新的防毒軟體。

3, 用一小張 memo 小抄下面的叮嚀！放在電腦桌旁。

.doc .ppt .pps .wmv 像前面這些夾帶檔案-可以開啟

.com .exe .bat .pig 像這樣的夾帶檔案-就不要開啟，回上一頁刪除。

4,剪下信箱中的二封病毒信作實例來說明。

【第一封信】說明：

【第二封信】說明：

1公斤的體脂肪約等於7700仟卡的熱量

1公斤的體脂肪約等於7700仟卡的熱量

1仟卡=1000卡
kcal或C又稱"大卡"
1千卡(kcal)(大卡)等於1000卡路里(cal),約4186焦耳
卡路里(簡稱「卡」，縮寫為「cal」),由英文Calorie直接音譯而來.

1公斤的體脂肪約等於7700仟卡的熱量
3500卡路里等於一膀

1英磅=0.45359237公斤
1英尺.磅=1.355焦耳
1焦耳=0.23899卡路里(Calorie)

電學換算

電學換算

伏特是國際單位制中電壓的單位,符號V

國際單位制中安培是基本電學單位,簡稱為安

安培,符號 A ,英文大寫I ,電流
伏特,符號 V ,英文大寫V ,電壓
歐姆,符號Ω ,英文大寫R ,電阻
"歐母定理" ,公式是V=I*R

要幾伏特等於一安培?
根據歐母定理V=I*R 代入"電阻值是要素"
當電阻值=1時 ,哪V=I*1 ,也就是1伏特=1安培
當電阻值=2時 ,哪V=I*2 ,也就是1伏特=2安培
兩者換算公式 V=I*R ,或I=V/R ,或R=V/I

瓦特,符號 W ,英文大寫P ,功率

瓦 安培 伏特之間要多少等於多少
公式為 P=V*I ,或P=I^2*R

例: 1安培 ,1伏特代入P=V*I ,可得1瓦特
　　1安培 ,2伏特代入P=V*I ,可得2瓦特

法拉,符號 F
西門,符號 S
庫侖(Coulomb),符號 C

比安培小的電流可以用毫安、微安等單位表示.
1安(A) = 1000毫安(mA)
1毫安(mA) = 1000微安(μA)
1庫侖=1安培·秒
1歐姆 Ω = 1*(V/A)
1千瓦=1000瓦特

XLINE運用

XLINE運用

(prompt "\n**<用途:建構=垂直線,VV>**")
(command "_.xline" "v" pause "")

(prompt "\n**<用途:建構=水平線,HH>**")
(command "_.xline" "h" pause "")

(prompt "\n**<用途:兩點水平垂直交線,X4>**")
(setq pta (GETPOINT "\n 點選水平位置:"))
(setq ptb (GETPOINT pta "\n 點選垂直位置:"))
(command "_.xline" "h" pta "")
(command "_.xline" "v" ptb "")

LISP_畫建築車道

(defun c:c1 ()(prompt "\n**<基本半徑,500>**")(command "_.CIRCLE" "T" Pause Pause "500")(prin1))

(defun c:c2 ()(prompt "\n**<雙車道<1050>,內徑:550.外徑:1050,中間:275>**")(command "_.CIRCLE" "T" Pause Pause "1050")(prin1))

(defun c:c3 ()(prompt "\n**<單車道<850>,內徑:350.外徑:850,中間:250>**")(command "_.CIRCLE" "T" Pause Pause "850")(prin1))

(defun c:cct ()(prompt "\n**<相切、相切、半徑畫圓>**")(command "_.CIRCLE" "T" )(prin1))