内径25外径47的轴承宽8:关于autolisp语言

来源:百度文库 编辑:中科新闻网 时间:2024/04/30 13:44:29
;;------------------------center ------------
(defun cenerror (st)
(if (/= st "Function cancelled")
(princ (strcat "\nError: " st))
)
(SETVAR "dimcen" cenvar)
(setvar "celtype" "BYLAYER")
(setvar "cecolor" "BYLAYER")
(setq *error* cenerr)
(princ)
)

(defun c:cen (/ cen1 cen2 l1 l2 ce1 ce2 cenvar cenerr sc covar ltvar)
(setq cenerr *error*
*error* cenerror
)

(setq cenvar (getvar "dimcen"))
(setq sc (getvar "dimscale"))

(setq covar (getvar "cecolor"))
(setvar "cecolor" "BYLAYER")

(setq ltvar (getvar "celtype"))
(setvar "celtype" "BYLAYER")

(while t
(setq cenxs 1)
(setq cen1 (nentsel "\n <Enter> center mark\\Please select a arc or circle:"))
(if (= cen1 nil)
(progn (setq cenxs 0.1) (setq cen1 (nentsel "\n<center mark>Please select a arc or circ:"))) )

(while (and (/= (cdr (assoc 0 (entget (car cen1)))) "ARC")
(/= (cdr (assoc 0 (entget (car cen1)))) "CIRCLE")
)
(setq cen1 (nentsel "\n Please select a arc or circle:"))
)

(setq cen2 (cdr(assoc 40 (entget (car cen1) ))))
(setvar "dimcen" (/ (* cen2 1.1 cenxs) sc) )
(setq cenxs 1)
(setq ce1 (entlast))

(command "dimcenter" (car (cdr cen1)))

(setq l1 (entget (entnext ce1)))
(setq ce1 (entnext ce1))
(setq l1 (subst (cons 8 "cen") (assoc 8 l1) l1 ))
(setq l1 (subst (cons 62 256) (assoc 62 l1) l1 ))
(entmod l1)

(setq l2 (entget (entnext ce1)))
(setq l2 (subst (cons 8 "cen") (assoc 8 l2) l2 ))
(setq l2 (subst (cons 62 256) (assoc 62 l2) l2 ))
(entmod l2)
)
(setvar "dimcen" cenvar)
(princ)
)

这是公司里自动给圆加中心线的程序,谁能帮我精简下然后放在原始版本的MNU文件里??
公司原来是基于2000版本的,现在要做成2004版本的。

说明你使用的是什么版本.
菜单文件随版本而不同.