以下這段程式是教您怎樣用程式去擷取出線段或圓的參數或內部詳細資訊
(defun C:tom20 (/ N w2 w3)
(setvar "OSMODE" 0)
(setq
a (ssget
'((0 . "TEXT,REGION,CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE,ARC"))
)
)
(setq n(sslength a))
(setq index 0)
(setq b1(entget (ssname a index)))
; (setq index (1+ index))
; (setq b(assoc 0 b1))
)
2013年10月2日 星期三
AUTOLISP將所有圖層關閉只留下選取之圖層
這支程式是前面開關圖層的進階版
用看看就知道了~~
標題寫很清楚~~
內行人一看就知道
(defun C:tom8 (/ a b b1 c n c2 index )
(setvar "cmdecho" 0)
(command"-layer""ON""*""")
(setq a (ssget))
(setq n(sslength a))
(setq c(ssname a 0))
(setq b1 (entget c))
;(entmod b1)
;(setq b1(entget (ssname a index)))
; (setq index (1+ index))
(setq b(assoc 8 b1))
(setq c1(cdr b))
(command"-layer" "OFF" "*" "Y" "")
(command"-layer" "ON" c1 "" "")
)
用看看就知道了~~
標題寫很清楚~~
內行人一看就知道
(defun C:tom8 (/ a b b1 c n c2 index )
(setvar "cmdecho" 0)
(command"-layer""ON""*""")
(setq a (ssget))
(setq n(sslength a))
(setq c(ssname a 0))
(setq b1 (entget c))
;(entmod b1)
;(setq b1(entget (ssname a index)))
; (setq index (1+ index))
(setq b(assoc 8 b1))
(setq c1(cdr b))
(command"-layer" "OFF" "*" "Y" "")
(command"-layer" "ON" c1 "" "")
)
AUTOLISP將物體移動至原點
這程式是小唐研究很久的一支程式
當年在雷射切割時光這動作就讓人吐血
所以利用上班之餘把這程式完成
足足研究了好幾個禮拜
終於讓我搞定了
它的作用在於把畫好的檔案先隱藏不必要的圖層
把雷射切割的線段留下
然後框選欲移動的線條
進行移動至原點(0,0)
並將物體儲存成DXF檔
(defun C:tom7 (/ N w2 w3)
(setvar "cmdecho" 0)
(setvar "OSMODE" 0)
(command "clayer" "0")
(command "-layer" "off" "標註線" "")
(command "-layer" "off" "正折" "")
(command "-layer" "off" "反折" "")
(command "-layer" "off" "虛線" "")
(command "-layer" "off" "中心線" "")
(setq xl 1000000)
(setq yl 1000000)
(setq m11 2000000)
(setq m12 2000000)
(setq g6 2000000)
(setq g7 2000000)
(setq c2 2000000)
(setq k 2000000)
(setq dd2 2000000)
(setq dy 2000000)
(setq
a (ssget
'((0 . "REGION,CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE,ARC"))
)
)
(setq n(sslength a))
(setq index 0)
(repeat n
(setq b1(entget (ssname a index)))
(setq index (1+ index))
(setq b(assoc 0 b1))
(if (= "LINE" (cdr b))
(progn
(setq c (assoc 10 b1))
(setq c1(cdr c))
(setq c2(car c1))
(setq k(cadr c1))
;k為y值
;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq DD (assoc 11 b1))
(setq DD1(cdr DD))
(setq DD2(car DD1))
(setq DY(cadr DD1))
;DY為y值
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
)
)
;;;;;;;;;;;;;;;;;;;;判斷ARC
(if (= "ARC" (cdr b))
(progn
(setq M1 (assoc 50 b1))
(SETQ M2 (ASSOC 40 b1))
(SETQ M3 (ASSOC 10 b1))
(SETQ M4 (ASSOC 51 b1))
;;m5為圓弧起始點徑度值
(setq m5 (cdr m1))
;;m6為圓弧結束點徑度值
(setq m6 (cdr m4))
;;m7為半徑
(setq m7 (cdr m2))
;;;;;;;;;;;;;;;;;;;;;;圓心
(setq m8 (cdr m3)) ;;圓心座標
(setq m9 (car m8)) ;;x值
(setq m10 (cadr m8)) ;;y值
(setq m13(/ (* 180 m5) pi)) ;起始角度m13
(if (< m6 m5)
(setq m14(+ (/ (* 180 m6) pi) 360)) ;結束角度m14
)
(if (> m6 m5)
(setq m14(/ (* 180 m6) pi)) ;結束角度m14
)
(if (>= m14 270);;;y
(cond
(( < m13 270) (setq m12(- m10 m7)))
(( > m13 270) (setq m12 2000000))
)
)
(if (<= m13 180);;x
(cond
(( > m14 180) (setq m11(- m9 m7)))
(( < m14 180) (setq m11 2000000))
)
)
)
)
;;;;;;;;;;;;;;;;;判斷ARC結束
;;;;;;;;;;;;;;;;;;;;判斷CIRCLE
(if (= "CIRCLE" (cdr b))
(progn
(setq g1 (assoc 10 b1))
(setq g2 (cdr g1))
(setq g3 (car g2)); 圓心x值
(setq g4 (cadr g2)) ;圓心y值
(setq CR (assoc 40 b1))
(setq g5 (cdr cr));;半徑g5
(setq g6 (- g3 g5)) ;x極小值
(setq g7 (- g4 g5)) ;y極小值
)
)
;;;;;;;;;;;;;;;;;判斷CIRCLE結束
;;判斷x最小值
(if (<= c2 xl)
(setq xl c2)
)
;;判斷y最小值
(if (<= k yl)
(setq yl k)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;
;;判斷x最小值
(if (<= DD2 xl)
(setq xl DD2)
)
;;判斷y最小值
(if (<= DY yl)
(setq yl DY)
)
;;;;;;;;;;;;;;;;;;;
;圓弧x極小值
(if (<= m11 xl)
(setq xl m11)
)
;;圓弧y極小值
(if (<= m12 yl)
(setq yl m12)
)
;;判斷圓x最小值
(if (<= g6 xl)
(setq xl g6)
)
;;判斷圓y最小值
(if (<= g7 yl)
(setq yl g7)
)
;;;;;;;;;;;;;;;;;repeat結束括弧
)
(setq xy (list xl yl))
(setq gh(list 0 0))
(setq ff(car xy))
(if (= ff nil)
(SETQ w3 (STRCAT "不成功" "再框選一次" ))
(progn
(setq w2(getstring "檔案名稱:"))
(setq dir(getvar "dwgprefix"))
(SETQ w3 (STRCAT dir w2 ".dxf" ))
;(SETQ w3 (STRCAT "D:\DXF\" w2 ".dxf" ))
(command "move" a "" xy gh)
(command "filedia" "0")
(command "dxfout" w3 "O" a "" "v" "R12" "")
(command "erase" a "")
(command "filedia" "1")
(setvar "OSMODE" 183)
(princ)
)
)
)
當年在雷射切割時光這動作就讓人吐血
所以利用上班之餘把這程式完成
足足研究了好幾個禮拜
終於讓我搞定了
它的作用在於把畫好的檔案先隱藏不必要的圖層
把雷射切割的線段留下
然後框選欲移動的線條
進行移動至原點(0,0)
並將物體儲存成DXF檔
(defun C:tom7 (/ N w2 w3)
(setvar "cmdecho" 0)
(setvar "OSMODE" 0)
(command "clayer" "0")
(command "-layer" "off" "標註線" "")
(command "-layer" "off" "正折" "")
(command "-layer" "off" "反折" "")
(command "-layer" "off" "虛線" "")
(command "-layer" "off" "中心線" "")
(setq xl 1000000)
(setq yl 1000000)
(setq m11 2000000)
(setq m12 2000000)
(setq g6 2000000)
(setq g7 2000000)
(setq c2 2000000)
(setq k 2000000)
(setq dd2 2000000)
(setq dy 2000000)
(setq
a (ssget
'((0 . "REGION,CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE,ARC"))
)
)
(setq n(sslength a))
(setq index 0)
(repeat n
(setq b1(entget (ssname a index)))
(setq index (1+ index))
(setq b(assoc 0 b1))
(if (= "LINE" (cdr b))
(progn
(setq c (assoc 10 b1))
(setq c1(cdr c))
(setq c2(car c1))
(setq k(cadr c1))
;k為y值
;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq DD (assoc 11 b1))
(setq DD1(cdr DD))
(setq DD2(car DD1))
(setq DY(cadr DD1))
;DY為y值
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
)
)
;;;;;;;;;;;;;;;;;;;;判斷ARC
(if (= "ARC" (cdr b))
(progn
(setq M1 (assoc 50 b1))
(SETQ M2 (ASSOC 40 b1))
(SETQ M3 (ASSOC 10 b1))
(SETQ M4 (ASSOC 51 b1))
;;m5為圓弧起始點徑度值
(setq m5 (cdr m1))
;;m6為圓弧結束點徑度值
(setq m6 (cdr m4))
;;m7為半徑
(setq m7 (cdr m2))
;;;;;;;;;;;;;;;;;;;;;;圓心
(setq m8 (cdr m3)) ;;圓心座標
(setq m9 (car m8)) ;;x值
(setq m10 (cadr m8)) ;;y值
(setq m13(/ (* 180 m5) pi)) ;起始角度m13
(if (< m6 m5)
(setq m14(+ (/ (* 180 m6) pi) 360)) ;結束角度m14
)
(if (> m6 m5)
(setq m14(/ (* 180 m6) pi)) ;結束角度m14
)
(if (>= m14 270);;;y
(cond
(( < m13 270) (setq m12(- m10 m7)))
(( > m13 270) (setq m12 2000000))
)
)
(if (<= m13 180);;x
(cond
(( > m14 180) (setq m11(- m9 m7)))
(( < m14 180) (setq m11 2000000))
)
)
)
)
;;;;;;;;;;;;;;;;;判斷ARC結束
;;;;;;;;;;;;;;;;;;;;判斷CIRCLE
(if (= "CIRCLE" (cdr b))
(progn
(setq g1 (assoc 10 b1))
(setq g2 (cdr g1))
(setq g3 (car g2)); 圓心x值
(setq g4 (cadr g2)) ;圓心y值
(setq CR (assoc 40 b1))
(setq g5 (cdr cr));;半徑g5
(setq g6 (- g3 g5)) ;x極小值
(setq g7 (- g4 g5)) ;y極小值
)
)
;;;;;;;;;;;;;;;;;判斷CIRCLE結束
;;判斷x最小值
(if (<= c2 xl)
(setq xl c2)
)
;;判斷y最小值
(if (<= k yl)
(setq yl k)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;
;;判斷x最小值
(if (<= DD2 xl)
(setq xl DD2)
)
;;判斷y最小值
(if (<= DY yl)
(setq yl DY)
)
;;;;;;;;;;;;;;;;;;;
;圓弧x極小值
(if (<= m11 xl)
(setq xl m11)
)
;;圓弧y極小值
(if (<= m12 yl)
(setq yl m12)
)
;;判斷圓x最小值
(if (<= g6 xl)
(setq xl g6)
)
;;判斷圓y最小值
(if (<= g7 yl)
(setq yl g7)
)
;;;;;;;;;;;;;;;;;repeat結束括弧
)
(setq xy (list xl yl))
(setq gh(list 0 0))
(setq ff(car xy))
(if (= ff nil)
(SETQ w3 (STRCAT "不成功" "再框選一次" ))
(progn
(setq w2(getstring "檔案名稱:"))
(setq dir(getvar "dwgprefix"))
(SETQ w3 (STRCAT dir w2 ".dxf" ))
;(SETQ w3 (STRCAT "D:\DXF\" w2 ".dxf" ))
(command "move" a "" xy gh)
(command "filedia" "0")
(command "dxfout" w3 "O" a "" "v" "R12" "")
(command "erase" a "")
(command "filedia" "1")
(setvar "OSMODE" 183)
(princ)
)
)
)
AUTOLISP畫長圓孔
每次畫長圓孔都必須搞個好幾筆動作才可完成
我今天提供一個簡單又快速的程式讓大家快速畫完橢圓孔
希望大家在製圖界工作愉快
(setq g 0)
(defun c:ted13(/ p1 p2 p3 p4 p5 p6 p7 p8 s pc v w1 L1 g1 OS)
(setq OS(getvar "OSMODE"))
(setvar "cmdecho" 0)
(setq v (getvar "clayer"))
(setq w1 w)(setq L1 L)(setq g1 g)
(setvar "OSMODE" 1207)
(setq pc(getpoint "長圓孔中心點:"))(terpri)
(prompt "寬度<")(princ w)(prompt ">:")(setq w (getdist pc))(terpri)
(if (= w nil) (setq w w1))
(prompt "長度<")(princ L)(prompt ">:")(setq L (getdist pc))(terpri)
(if (= L nil) (setq L L1))
(prompt "角度<")(princ (/ (* g 180.0) pi))(prompt ">:")(setq g (getangle pc))(terpri)
(if (= g nil) (setq g g1))
(setq s (* (getvar "dimlfac") 1.5))
(setq p1(polar pc (+ g (/ pi 2)) (+ (/ w 2) s)))
(setq p2(polar pc (- g (/ pi 2)) (+ (/ w 2) s)))
(setq p3(polar pc g (+ (/ L 2) s)))
(setq p4(polar pc (+ g pi) (+ (/ L 2) s)))
(setq p5(polar pc (+ (atan (/ w 2) (/ (- L w) 2)) g)
(expt (+ (expt (/ (- L w) 2) 2) (expt (/ w 2) 2)) 0.5)))
(setq p6(polar p5 (+ g pi) (- L w)))
(setq p7(polar p6 (- g (/ pi 2)) w))
(setq p8(polar p5 (- g (/ pi 2)) w))
(setvar "OSMODE" 0)
(setvar "CLAYER" "0")
(command "arc" p6 "E" p7 "R" (/ w 2))
(command "arc" p8 "E" p5 "R" (/ w 2))
(command "line" p5 p6 "")
(command "line" p7 p8 "")
(setvar "CLAYER" V)
(setvar "OSMODE" OS)
(princ)
)
我今天提供一個簡單又快速的程式讓大家快速畫完橢圓孔
希望大家在製圖界工作愉快
(setq g 0)
(defun c:ted13(/ p1 p2 p3 p4 p5 p6 p7 p8 s pc v w1 L1 g1 OS)
(setq OS(getvar "OSMODE"))
(setvar "cmdecho" 0)
(setq v (getvar "clayer"))
(setq w1 w)(setq L1 L)(setq g1 g)
(setvar "OSMODE" 1207)
(setq pc(getpoint "長圓孔中心點:"))(terpri)
(prompt "寬度<")(princ w)(prompt ">:")(setq w (getdist pc))(terpri)
(if (= w nil) (setq w w1))
(prompt "長度<")(princ L)(prompt ">:")(setq L (getdist pc))(terpri)
(if (= L nil) (setq L L1))
(prompt "角度<")(princ (/ (* g 180.0) pi))(prompt ">:")(setq g (getangle pc))(terpri)
(if (= g nil) (setq g g1))
(setq s (* (getvar "dimlfac") 1.5))
(setq p1(polar pc (+ g (/ pi 2)) (+ (/ w 2) s)))
(setq p2(polar pc (- g (/ pi 2)) (+ (/ w 2) s)))
(setq p3(polar pc g (+ (/ L 2) s)))
(setq p4(polar pc (+ g pi) (+ (/ L 2) s)))
(setq p5(polar pc (+ (atan (/ w 2) (/ (- L w) 2)) g)
(expt (+ (expt (/ (- L w) 2) 2) (expt (/ w 2) 2)) 0.5)))
(setq p6(polar p5 (+ g pi) (- L w)))
(setq p7(polar p6 (- g (/ pi 2)) w))
(setq p8(polar p5 (- g (/ pi 2)) w))
(setvar "OSMODE" 0)
(setvar "CLAYER" "0")
(command "arc" p6 "E" p7 "R" (/ w 2))
(command "arc" p8 "E" p5 "R" (/ w 2))
(command "line" p5 p6 "")
(command "line" p7 p8 "")
(setvar "CLAYER" V)
(setvar "OSMODE" OS)
(princ)
)
AUTOLISP畫小圓孔
;畫小圓孔 1.5 ,2 ,1
(defun c:ted10()(OO 1.5 "C0"))
(defun c:ted12()(OO 2 "C0"))
(defun c:ted11()(OO 1 "dim"))
(defun OO(D LA / cen s v OS)
(setq OS(getvar "OSMODE"))
(setq v (getvar "clayer"))
(setq s (getvar "dimlfac"))
(setvar "cmdecho" 0)
(setvar "OSMODE" 1189)
(setq cen (getpoint "Center point:"))(terpri)
(setvar "CLAYER" LA)
(setvar "OSMODE" 0)
(command "CIRCLE" cen "D" (* s D))
(setvar "CLAYER" "CEN")
(command "LINE" (list (car cen) (- (cadr cen) (* s d)))
(list (car cen) (+ (cadr cen) (* s d))) "")
(command "LINE" (list (- (car cen) (* s d)) (cadr cen))
(list (+ (car cen) (* s d)) (cadr cen)) "")
(setvar "OSMODE" OS)
(setvar "CLAYER" V)
(princ)
)
(defun c:ted10()(OO 1.5 "C0"))
(defun c:ted12()(OO 2 "C0"))
(defun c:ted11()(OO 1 "dim"))
(defun OO(D LA / cen s v OS)
(setq OS(getvar "OSMODE"))
(setq v (getvar "clayer"))
(setq s (getvar "dimlfac"))
(setvar "cmdecho" 0)
(setvar "OSMODE" 1189)
(setq cen (getpoint "Center point:"))(terpri)
(setvar "CLAYER" LA)
(setvar "OSMODE" 0)
(command "CIRCLE" cen "D" (* s D))
(setvar "CLAYER" "CEN")
(command "LINE" (list (car cen) (- (cadr cen) (* s d)))
(list (car cen) (+ (cadr cen) (* s d))) "")
(command "LINE" (list (- (car cen) (* s d)) (cadr cen))
(list (+ (car cen) (* s d)) (cadr cen)) "")
(setvar "OSMODE" OS)
(setvar "CLAYER" V)
(princ)
)
AUTOLISP畫中心線程式
;;畫中心線程式
(defun c:ted4(/ v CEN os)
(setvar "cmdecho" 0)
(setq v (getvar "clayer"))
(setq OS(getvar "OSMODE"))
(setvar "osmode" 4)
(setq r1 r)
(setq cen (getpoint "選取中心點:"))(terpri)
(cond ((= CEN nil)(setvar "OSMODE" OS)))
(prompt "中心線拉出長度<")(princ r)(prompt ">:")(setq r (getdist cen))(terpri)
(cond ((= r nil)(setq r r1)))
(cond ((> r 1)
(setvar "CLAYER" "中心線")
(setvar "OSMODE" 0)
(command "LINE" (list (car CEN) (- (cadr CEN) r))
(list (car CEN) (+ (cadr CEN) r)) "")
(command "LINE" (list (- (car CEN) r) (cadr CEN))
(list (+ (car CEN) r) (cadr CEN)) "")
(setvar "OSMODE" OS)
(setvar "CLAYER" V)
(princ)
)))
(defun c:ted4(/ v CEN os)
(setvar "cmdecho" 0)
(setq v (getvar "clayer"))
(setq OS(getvar "OSMODE"))
(setvar "osmode" 4)
(setq r1 r)
(setq cen (getpoint "選取中心點:"))(terpri)
(cond ((= CEN nil)(setvar "OSMODE" OS)))
(prompt "中心線拉出長度<")(princ r)(prompt ">:")(setq r (getdist cen))(terpri)
(cond ((= r nil)(setq r r1)))
(cond ((> r 1)
(setvar "CLAYER" "中心線")
(setvar "OSMODE" 0)
(command "LINE" (list (car CEN) (- (cadr CEN) r))
(list (car CEN) (+ (cadr CEN) r)) "")
(command "LINE" (list (- (car CEN) r) (cadr CEN))
(list (+ (car CEN) r) (cadr CEN)) "")
(setvar "OSMODE" OS)
(setvar "CLAYER" V)
(princ)
)))
AUTOLISP門板展開程式
這幾天畫電控箱畫到有點走火入魔
所以寫了自動產生電控箱的程式來增加我的工作速度
好讓我有更多悠閒的時間
想要學LISP程式的網友們可以看看我的程式來學
因為我也都是寫一些基本型態的程式
所以淺顯易懂
(defun C:line7 (/ a b c x2 p1 p4)
(setvar "cmdecho" 0)
(setvar "OSMODE" 0)
(if (= (tblsearch "layer" "標註線") nil)
(command "-layer" "n" "標註線" "c" "13" "標註線" ""))
(if (= (tblsearch "layer" "正折") nil)
(command "-layer" "n" "正折" "c" "6" "正折" ""))
(if (= (tblsearch "layer" "畫線") nil)
(command "-layer" "n" "畫線" "c" "2" "畫線" ""))
(if (= (tblsearch "layer" "打點") nil)
(command "-layer" "n" "打點" "c" "4" "打點" ""))
(if (= (tblsearch "layer" "文字") nil)
(command "-layer" "n" "文字" "c" "5" "文字" ""))
(if (= (tblsearch "layer" "虛線") nil)
(command "-layer" "n" "虛線" "c" "3" "虛線" "L" "DASHED" "虛線" ""))
(if (= (tblsearch "layer" "中心線") nil)
(command "-layer" "n" "中心線" "c" "1" "中心線" "L" "CENTER" "中心線" ""))
(if (= (tblsearch "layer" "圖框線") nil)
(command "-layer" "n" "圖框線" "c" "8" "圖框線" ""))
(if (= (tblsearch "layer" "圖框") nil)
(command "-layer" "n" "圖框" "c" "8" "圖框" ""))
(if (= (tblsearch "layer" "反折") nil)
(command "-layer" "n" "反折" "c" "3" "反折" "L" "DASHED" "反折" ""))
(setq c1(getpoint "\n圖形插入點:"))
(setq W1(getreal "\n輸入門板寬度="))
(setq l1(getreal "\n輸入門板高度="))
(setq h1(getreal "\n輸入門板深度="))
(setq x1(getreal "\n輸入板金延伸量="))
(setq d1(- (/ w1 2) x1))
(setq d2(- (/ l1 2) x1))
(setq x2(+ x1 x1))
(setq p1(list(- (car c1) d1) (+ (cadr c1) d2)))
(setq p2(list(+ (car c1) d1) (+ (cadr c1) d2)))
(setq p3(list(+ (car c1) d1) (- (cadr c1) d2)))
(setq p4(list(- (car c1) d1) (- (cadr c1) d2)))
(setq p5(list(- (car p1) (- h1 x2)) (cadr p1)))
(setq p6(list(- (car p4) (- h1 x2)) (cadr p4)))
(setq p7(list(+ (car p2) (- h1 x2)) (cadr p2)))
(setq p8(list(+ (car p3) (- h1 x2)) (cadr p3)))
(setq p9(list(car p1) (+ (cadr p1) (- h1 x2))))
(setq p10(list(car p2) (+ (cadr p2) (- h1 x2))))
(setq p11(list(car p4) (- (cadr p4) (- h1 x2))))
(setq p12(list(car p3) (- (cadr p3) (- h1 x2))))
(setq p13(list(car p1) (+ (cadr p1) 0.2)))
(setq p14(list(- (car p13) x1)(cadr p13)))
(setq p15(list(car p14)(- (+ (cadr p1) h1) x2)))
(setq p16(list(+ (car p15) x1)(cadr p15)))
(setq p17(list(- (+ (car p16) 12) x1)(- (+ (cadr p16) 12) x1)))
(setq p22(list(car p2) (+ (cadr p2) 0.2)))
(setq p21(list(+ (car p22) x1)(cadr p22)))
(setq p20(list(car p21)(- (+ (cadr p2) h1) x2)))
(setq p19(list(- (car p20) x1)(cadr p20)))
(setq p18(list(+ (- (car p19) 12) x1)(- (+ (cadr p19) 12) x1)))
(setq p23(list(- (+ (car p7) h1) x1)(+ (- (cadr p7) h1) x1)))
(setq p24(list(- (+ (car p8) h1) x1)(- (+ (cadr p8) h1) x1)))
(setq p25(list(+ (- (car p5) h1) x1)(+ (- (cadr p5) h1) x1)))
(setq p26(list(+ (- (car p6) h1) x1)(- (+ (cadr p6) h1) x1)))
(setq p27(list(car p4) (- (cadr p4) 0.2)))
(setq p28(list(- (car p27) x1)(cadr p27)))
(setq p29(list(car p28)(+ (- (cadr p4) h1) x2)))
(setq p30(list(+ (car p29) x1)(cadr p29)))
(setq p31(list(- (+ (car p30) 12) x1)(+ (- (cadr p30) 12) x1)))
(setq p36(list(car p3) (- (cadr p3) 0.2)))
(setq p35(list(+ (car p36) x1)(cadr p36)))
(setq p34(list(car p35)(+ (- (cadr p3) h1) x2)))
(setq p33(list(- (car p34) x1)(cadr p34)))
(setq p32(list(+ (- (car p33) 12) x1)(+ (- (cadr p33) 12) x1)))
(setq p37(list(car p4) (+ (cadr p4) (/ l1 2))))
(setvar "CLAYER" "反折")
(command "line" p1 p2 p3 p4 "c")
(command "line" p5 p6 "")
(command "line" p7 p8 "")
(command "line" p9 p10 "")
(command "line" p11 p12 "")
(setvar "CLAYER" "0")
(command "line" p3 p36 p35 p34 p33 p32 p31 p30 p29 p28 p27 p4 p6 p26 p25 p5 p1 p13 p14 p15 p16 p17 p18 p19 p20 p21 p22 p2 p7 p23 p24 p8 p3 "")
(setq p1(list(+ (car p37) (- 53.5 x1)) (cadr p37)))
(setq p2(list(- (car p1) 11.5) (+ (cadr p1) 32.5)))
(setq p3(list(+ (car p1) 11.5) (+ (cadr p1) 32.5)))
(setq p4(list(+ (car p1) 11.5) (- (cadr p1) 32.5)))
(setq p5(list(- (car p1) 11.5) (- (cadr p1) 32.5)))
(setq p6(list(+ (car p2) 8) (cadr p2)))
(setq p7(list(- (car p3) 8) (cadr p3)))
(setq p8(list(- (car p4) 8) (cadr p4)))
(setq p9(list(+ (car p5) 8) (cadr p5)))
(setq p10(list(car p6) (+ (cadr p6) 4.5)))
(setq p11(list(car p7) (+ (cadr p7) 4.5)))
(setq p12(list(car p8) (- (cadr p8) 4.5)))
(setq p13(list(car p9) (- (cadr p9) 4.5)))
(setq p14(list(car p1) (+ (cadr p1) 40.5)))
(setq p15(list(car p1) (- (cadr p1) 40.5)))
(command "line" p10 p6 p2 p5 p9 p13 "")
(command "line" p11 p7 p3 p4 p8 p12 "")
(command "arc" p10 p14 p11)
(command "arc" p13 p15 p12)
(setvar "OSMODE" 183)
(princ)
)
所以寫了自動產生電控箱的程式來增加我的工作速度
好讓我有更多悠閒的時間
想要學LISP程式的網友們可以看看我的程式來學
因為我也都是寫一些基本型態的程式
所以淺顯易懂
(defun C:line7 (/ a b c x2 p1 p4)
(setvar "cmdecho" 0)
(setvar "OSMODE" 0)
(if (= (tblsearch "layer" "標註線") nil)
(command "-layer" "n" "標註線" "c" "13" "標註線" ""))
(if (= (tblsearch "layer" "正折") nil)
(command "-layer" "n" "正折" "c" "6" "正折" ""))
(if (= (tblsearch "layer" "畫線") nil)
(command "-layer" "n" "畫線" "c" "2" "畫線" ""))
(if (= (tblsearch "layer" "打點") nil)
(command "-layer" "n" "打點" "c" "4" "打點" ""))
(if (= (tblsearch "layer" "文字") nil)
(command "-layer" "n" "文字" "c" "5" "文字" ""))
(if (= (tblsearch "layer" "虛線") nil)
(command "-layer" "n" "虛線" "c" "3" "虛線" "L" "DASHED" "虛線" ""))
(if (= (tblsearch "layer" "中心線") nil)
(command "-layer" "n" "中心線" "c" "1" "中心線" "L" "CENTER" "中心線" ""))
(if (= (tblsearch "layer" "圖框線") nil)
(command "-layer" "n" "圖框線" "c" "8" "圖框線" ""))
(if (= (tblsearch "layer" "圖框") nil)
(command "-layer" "n" "圖框" "c" "8" "圖框" ""))
(if (= (tblsearch "layer" "反折") nil)
(command "-layer" "n" "反折" "c" "3" "反折" "L" "DASHED" "反折" ""))
(setq c1(getpoint "\n圖形插入點:"))
(setq W1(getreal "\n輸入門板寬度="))
(setq l1(getreal "\n輸入門板高度="))
(setq h1(getreal "\n輸入門板深度="))
(setq x1(getreal "\n輸入板金延伸量="))
(setq d1(- (/ w1 2) x1))
(setq d2(- (/ l1 2) x1))
(setq x2(+ x1 x1))
(setq p1(list(- (car c1) d1) (+ (cadr c1) d2)))
(setq p2(list(+ (car c1) d1) (+ (cadr c1) d2)))
(setq p3(list(+ (car c1) d1) (- (cadr c1) d2)))
(setq p4(list(- (car c1) d1) (- (cadr c1) d2)))
(setq p5(list(- (car p1) (- h1 x2)) (cadr p1)))
(setq p6(list(- (car p4) (- h1 x2)) (cadr p4)))
(setq p7(list(+ (car p2) (- h1 x2)) (cadr p2)))
(setq p8(list(+ (car p3) (- h1 x2)) (cadr p3)))
(setq p9(list(car p1) (+ (cadr p1) (- h1 x2))))
(setq p10(list(car p2) (+ (cadr p2) (- h1 x2))))
(setq p11(list(car p4) (- (cadr p4) (- h1 x2))))
(setq p12(list(car p3) (- (cadr p3) (- h1 x2))))
(setq p13(list(car p1) (+ (cadr p1) 0.2)))
(setq p14(list(- (car p13) x1)(cadr p13)))
(setq p15(list(car p14)(- (+ (cadr p1) h1) x2)))
(setq p16(list(+ (car p15) x1)(cadr p15)))
(setq p17(list(- (+ (car p16) 12) x1)(- (+ (cadr p16) 12) x1)))
(setq p22(list(car p2) (+ (cadr p2) 0.2)))
(setq p21(list(+ (car p22) x1)(cadr p22)))
(setq p20(list(car p21)(- (+ (cadr p2) h1) x2)))
(setq p19(list(- (car p20) x1)(cadr p20)))
(setq p18(list(+ (- (car p19) 12) x1)(- (+ (cadr p19) 12) x1)))
(setq p23(list(- (+ (car p7) h1) x1)(+ (- (cadr p7) h1) x1)))
(setq p24(list(- (+ (car p8) h1) x1)(- (+ (cadr p8) h1) x1)))
(setq p25(list(+ (- (car p5) h1) x1)(+ (- (cadr p5) h1) x1)))
(setq p26(list(+ (- (car p6) h1) x1)(- (+ (cadr p6) h1) x1)))
(setq p27(list(car p4) (- (cadr p4) 0.2)))
(setq p28(list(- (car p27) x1)(cadr p27)))
(setq p29(list(car p28)(+ (- (cadr p4) h1) x2)))
(setq p30(list(+ (car p29) x1)(cadr p29)))
(setq p31(list(- (+ (car p30) 12) x1)(+ (- (cadr p30) 12) x1)))
(setq p36(list(car p3) (- (cadr p3) 0.2)))
(setq p35(list(+ (car p36) x1)(cadr p36)))
(setq p34(list(car p35)(+ (- (cadr p3) h1) x2)))
(setq p33(list(- (car p34) x1)(cadr p34)))
(setq p32(list(+ (- (car p33) 12) x1)(+ (- (cadr p33) 12) x1)))
(setq p37(list(car p4) (+ (cadr p4) (/ l1 2))))
(setvar "CLAYER" "反折")
(command "line" p1 p2 p3 p4 "c")
(command "line" p5 p6 "")
(command "line" p7 p8 "")
(command "line" p9 p10 "")
(command "line" p11 p12 "")
(setvar "CLAYER" "0")
(command "line" p3 p36 p35 p34 p33 p32 p31 p30 p29 p28 p27 p4 p6 p26 p25 p5 p1 p13 p14 p15 p16 p17 p18 p19 p20 p21 p22 p2 p7 p23 p24 p8 p3 "")
(setq p1(list(+ (car p37) (- 53.5 x1)) (cadr p37)))
(setq p2(list(- (car p1) 11.5) (+ (cadr p1) 32.5)))
(setq p3(list(+ (car p1) 11.5) (+ (cadr p1) 32.5)))
(setq p4(list(+ (car p1) 11.5) (- (cadr p1) 32.5)))
(setq p5(list(- (car p1) 11.5) (- (cadr p1) 32.5)))
(setq p6(list(+ (car p2) 8) (cadr p2)))
(setq p7(list(- (car p3) 8) (cadr p3)))
(setq p8(list(- (car p4) 8) (cadr p4)))
(setq p9(list(+ (car p5) 8) (cadr p5)))
(setq p10(list(car p6) (+ (cadr p6) 4.5)))
(setq p11(list(car p7) (+ (cadr p7) 4.5)))
(setq p12(list(car p8) (- (cadr p8) 4.5)))
(setq p13(list(car p9) (- (cadr p9) 4.5)))
(setq p14(list(car p1) (+ (cadr p1) 40.5)))
(setq p15(list(car p1) (- (cadr p1) 40.5)))
(command "line" p10 p6 p2 p5 p9 p13 "")
(command "line" p11 p7 p3 p4 p8 p12 "")
(command "arc" p10 p14 p11)
(command "arc" p13 p15 p12)
(setvar "OSMODE" 183)
(princ)
)
AUTOLISP顯示日期
每張CAD圖框都有一個日期欄位,每建立一張圖面有時會遺忘更改
所以寫了一個簡單的程式來增加這速度
可以更改日期的座標來快速輸入
(defun c:DATE(/ TX TX1 S S1 S2 S3 )
(setvar "cmdecho" 0)
(setq tx(fix (getvar "CDATE")))
(setq tx1(itoa (fix (- tx (* (fix (/ tx 10000.000000000)) 10000.0000000)))))
(if (= (strlen tx1) 3) (setq tx1(strcat "0" tx1)))
(setq s1(itoa (fix (- (/ tx 10000) 1911))))
(setq s2(substr tx1 1 2))
(setq s3(substr tx1 3 2))
(setq s(strcat s1 "." s2 "." s3))
(command "text" "M" "none" "90,48.33333" "4" "0" s)
)
所以寫了一個簡單的程式來增加這速度
可以更改日期的座標來快速輸入
(defun c:DATE(/ TX TX1 S S1 S2 S3 )
(setvar "cmdecho" 0)
(setq tx(fix (getvar "CDATE")))
(setq tx1(itoa (fix (- tx (* (fix (/ tx 10000.000000000)) 10000.0000000)))))
(if (= (strlen tx1) 3) (setq tx1(strcat "0" tx1)))
(setq s1(itoa (fix (- (/ tx 10000) 1911))))
(setq s2(substr tx1 1 2))
(setq s3(substr tx1 3 2))
(setq s(strcat s1 "." s2 "." s3))
(command "text" "M" "none" "90,48.33333" "4" "0" s)
)
AUTOLISP - 套用新建圖層
當你安裝好AUTOCAD軟體才ㄈㄚ
(defun c:newlayer(/ a b c d)
(setvar "cmdecho" 0)
(command "clayer" "0")
(if (= (tblsearch "layer" "標註線") nil)
(command "-layer" "n" "標註線" "c" "13" "標註線" ""))
(if (= (tblsearch "layer" "正折") nil)
(command "-layer" "n" "正折" "c" "6" "正折" ""))
(if (= (tblsearch "layer" "畫線") nil)
(command "-layer" "n" "畫線" "c" "2" "畫線" ""))
(if (= (tblsearch "layer" "打點") nil)
(command "-layer" "n" "打點" "c" "4" "打點" ""))
(if (= (tblsearch "layer" "文字") nil)
(command "-layer" "n" "文字" "c" "5" "文字" ""))
(if (= (tblsearch "layer" "虛線") nil)
(command "-layer" "n" "虛線" "c" "3" "虛線" "L" "DASHED" "虛線" ""))
(if (= (tblsearch "layer" "中心線") nil)
(command "-layer" "n" "中心線" "c" "1" "中心線" "L" "CENTER" "中心線" ""))
(if (= (tblsearch "layer" "圖框線") nil)
(command "-layer" "n" "圖框線" "c" "8" "圖框線" ""))
(if (= (tblsearch "layer" "圖框") nil)
(command "-layer" "n" "圖框" "c" "8" "圖框" ""))
(if (= (tblsearch "layer" "反折") nil)
(command "-layer" "n" "反折" "c" "3" "反折" "L" "DASHED" "反折" ""))
)
(defun c:newlayer(/ a b c d)
(setvar "cmdecho" 0)
(command "clayer" "0")
(if (= (tblsearch "layer" "標註線") nil)
(command "-layer" "n" "標註線" "c" "13" "標註線" ""))
(if (= (tblsearch "layer" "正折") nil)
(command "-layer" "n" "正折" "c" "6" "正折" ""))
(if (= (tblsearch "layer" "畫線") nil)
(command "-layer" "n" "畫線" "c" "2" "畫線" ""))
(if (= (tblsearch "layer" "打點") nil)
(command "-layer" "n" "打點" "c" "4" "打點" ""))
(if (= (tblsearch "layer" "文字") nil)
(command "-layer" "n" "文字" "c" "5" "文字" ""))
(if (= (tblsearch "layer" "虛線") nil)
(command "-layer" "n" "虛線" "c" "3" "虛線" "L" "DASHED" "虛線" ""))
(if (= (tblsearch "layer" "中心線") nil)
(command "-layer" "n" "中心線" "c" "1" "中心線" "L" "CENTER" "中心線" ""))
(if (= (tblsearch "layer" "圖框線") nil)
(command "-layer" "n" "圖框線" "c" "8" "圖框線" ""))
(if (= (tblsearch "layer" "圖框") nil)
(command "-layer" "n" "圖框" "c" "8" "圖框" ""))
(if (= (tblsearch "layer" "反折") nil)
(command "-layer" "n" "反折" "c" "3" "反折" "L" "DASHED" "反折" ""))
)
AUTOLISP-關閉圖層
身為機械業的我不外乎最常見的就是常常在關閉及打開圖層
這些惱人的動作讓人枯燥
所以小唐寫了一個簡單不過的幾句語法來克服這些煩躁的動作
有需要的網友可以載入試看看
(defun c:closelayer(/ g)
(setvar "cmdecho" 0)
(setvar "OSMODE" 0)
(command "clayer" "0")
(setq a(ssget ))
(setq b(ssname a 0))
(setq c(entget b))
(setq d(assoc 8 c))
(setq e(cdr d))
(command "-layer" off e "")
)
這些惱人的動作讓人枯燥
所以小唐寫了一個簡單不過的幾句語法來克服這些煩躁的動作
有需要的網友可以載入試看看
(defun c:closelayer(/ g)
(setvar "cmdecho" 0)
(setvar "OSMODE" 0)
(command "clayer" "0")
(setq a(ssget ))
(setq b(ssname a 0))
(setq c(entget b))
(setq d(assoc 8 c))
(setq e(cdr d))
(command "-layer" off e "")
)
訂閱：
文章 (Atom)