圆的中心线[原创]

jingsabing · 发表于 2002-6-7 15:20:00

;这是一个基于 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" &quot_CENTER"))
  (if (/= lay_exist nil)
(setvar "CLAYER" &quot_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

圆的中心线[原创]

发表回复

精选推荐

浏览过的版块