以下這段程式是教您怎樣用程式去擷取出線段或圓的參數或內部詳細資訊
(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)
)))
訂閱：
文章 (Atom)