iCAx开思网

标题: 矩形加载中心线... [打印本页]

作者: dss1280 时间: 2006-1-19 10:55
标题: 矩形加载中心线...
矩形加载中心线

(defun c:recn ()
(SETQ OS_OLD (GETVAR "OSMODE"))
(command "osnap" "inter")
(save_layer)
(setq clay (getvar "CLAYER"))
(if (= chinese "NO") (PROGN
   (setq p1 (getpoint "\nSelect a intersection pt: "))
   (setq p2 (getpoint p1 "\nSelect corner intersection pt: "))
   (command "osnap" "")
   (setq ddx (getdist p1 "\nExtension dist: ")));END PROGN
                  (PROGN
   (setq p1 (getpoint "\n选取矩形的第一对角点:"))
   (setq p2 (getpoint p1 "\n选取矩形的另一对角点:"))
   (command "osnap" "")
);END PROGN
);END IF
  (setq x1 (car p1))
  (setq x2 (car p2))
  (setq dx (abs (- x1 x2)))
  (if (/= dx 0) (setq d1 dx))
  (setq y1 (cadr p1))
  (setq y2 (cadr p2))
  (setq dy (abs (- y1 y2)))
  (if (/= dy 0) (setq d2 dy))
  (if (> x1 x2) (setq minx x2) (setq minx x1))
  (if (> y1 y2) (setq miny y2) (setq miny y1))
  (setq minp (list minx miny))
  (setq cp (polar (polar minp 0 (/ d1 2.0)) (/ pi 2.0) (/ d2 2.0)))
(if (not (tblsearch "layer" "center"))
(command "layer" "n" "center" "color" "red" "center" "l" "center" "center" "")
(command "_.layer" "thaw" "center" "on" "center" "unlock" "center" "")
  )
(setvar "clayer" "center")
  (command "line" (polar cp 0 (+ (/ d1 2.0) 1))
               (polar cp pi (+ (/ d1 2.0) 1))
               ""
               "LINE"
               (polar cp (/ pi 2.0) (+ (/ d2 2.0) 1))
               (polar cp (/ (* pi 3.0) 2.0) (+ (/ d2 2.0) 1))
               ""
  )
(setvar "clayer" clay)
(setvar "OSMODE" OS_OLD)
)

欢迎光临 iCAx开思网 (https://www.icax.org/)