圆的中心线[原创]

jingsabing

;这是一个基于AutoCAD 14.0下关于画中心线的程序
;它可以在P_CENTER层上画出选中的圆或圆弧的中心线
;本程序作者b.w
;本程序无偿使用
;如有更好建议，请联系b.w
;版本:1.0.00
;日期:27/12-2001

(defun B_DRAW_CLINE
  (
  cen
  rad
  /
  current_layer
  lay_exist
  lay_line
  current_lt
  )
  (setq current_layer (getvar "CLAYER"))
  (setq lay_exist (tblsearch "layer" "_CENTER"))
  (if (/= lay_exist nil)
    (setvar "CLAYER" "_CENTER")
    (setvar "CLAYER" current_layer)
  );end-if
  (setq lay_line (tblsearch "LTYPE" "CENTER"))
  (if (= lay_line nil)
      (command "-layer" "l" "center" "" "l" "" "" ""
      );end-command
  );end-if
  (setq current_lt (getvar "CELTYPE"))
  (if (/= current_lt "CENTER")
    (setvar "CELTYPE" "CENTER")
    (setvar "CELTYPE" "BYLAYER")
  );end-if
  (setvar "OSMODE"        0)
  (command "line" (list (+ (car cen) (* rad 1.2)) (cadr cen) 0)
                  (list (- (car cen) (* rad 1.2)) (cadr cen) 0) ""
  );end-command
  (command "line" (list (car cen) (+ (cadr cen) (* rad 1.2)) 0)
                  (list (car cen) (- (cadr cen) (* rad 1.2)) 0) ""
  );end-command
  (setvar "OSMODE"        51)
   ;end-command
  (setvar "CELTYPE" current_lt)
  (setvar "CLAYER" current_layer)
);end-B_DRAW_CLINE

(defun B_CIRCLINE
  (
  /
  ent
  ifcircle
  center
  radius
  )
  (setq ent (entget (car (entsel))))
  (setq ifcircle (cdr (assoc 0 ent)))
  (if (or (= ifcircle "CIRCLE") (= ifcircle "ARC"))
    (progn
      (setq center (cdr (assoc 10 ent)))
      (setq radius (cdr (assoc 40 ent)))
      (B_DRAW_CLINE center radius)
    );end-progn
    (prompt "\nThis is not a circle or arc!")
  );end-if
  (princ)
);end-B_CIRCLINE