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

)