材料利用率

主函数
(defun c:ma(/ ju pt cuhi hi text text-list)
(setq ju nil)
(initget "1 2")
(setq ju (getkword "\n请选择模具类型(1 工程模/2 连续模):<1>"))
(if (= ju nil) (setq ju "1"))
(cond
((= ju "1") (endie))
((= ju "2") (prodie))
)
(setq pt (trans (getpoint "\n请指定注解文字插入点:") 1 0))
(setq hi nil)
(setq cuhi (rtos (getvar "textsize") 2 2))
(setq hi (getreal (strcat "\n指定文字高度:" "<" cuhi ">")))
(if (= hi nil) (setq hi (atof cuhi)))
(setq text (strcat "材料利用率为" rate))
(setq text-list (list (cons '0 "TEXT") (cons '10 pt) (cons '40 hi) (cons '1 text) (cons '50 0.0)))
(entmake text-list)
(princ)
)
;工程利用率计算
(defun endie (/ acadobject acaddocument all-area part-area hole-area use-area num name vlxobj
ju ss len n)
(vl-load-com)
(setq acadobject (vlax-get-acad-object))
(setq acaddocument (vla-get-activedocument acadobject))
(setq all-area 0)
(setq part-area 0)
(setq hole-area 0)
(setq use-area 0)
(initget 1)
(setq num (getint "\n请输入冲裁的数量:"))
(setq name (car (entsel "\n请选择板料的外形:")))
(while (= name nil)
(princ "\n没有选择到图元!继续选择:")
(setq name (car (entsel "\n请选择板料的外形:")))
)
(setq vlxobj (vlax-ename->vla-object name))
(setq all-area (vlax-curve-getarea vlxobj))
(setq name (car (entsel "\n请选择产品外形:")))
(while (= name nil)
(princ "\n没有选择到图元!继续选择:")
(setq name (car (entsel "\n请选择产品外形:")))
)
(setq vlxobj (vlax-ename->vla-object name))
(setq part-area (vlax-curve-getarea vlxobj))
(initget "Yes No")
(setq ju nil)
(setq ju (getkword "\n产品是否有内孔?(Yes/No):"))
(if (= ju nil) (setq ju "Yes"))
(if (= ju "Yes")
(progn
(princ "\n请选择内孔")
(setq ss (ssget))
(while (= ss nil)
(princ "\n没有选择到图元!继续选择:")
(setq ss (ssget))
)
(setq len nil)
(setq len (sslength ss))
(setq n 0)
(while (< n len)
(setq name (ssname ss n))
(setq vlxobj (vlax-ename->vla-object name))
(setq area (vlax-curve-getarea vlxobj))
(setq hole-area (+ hole-area area))
(setq n (1+ n))
)
)
)
(setq use-area (* (- part-area hole-area) num))
(setq rate (strcat (rtos (* (/ use-area all-area) 100) 2 3) "%"))
(princ)
)
;连续模利用率计算
(defun prodie (/ acadobject acaddocument all-area part-area hole-area use-area num name vlxobj
ju ss len n)
(vl-load-com)
(setq acadobject (vlax-get-acad-object))
(setq acaddocument (vla-get-activedocument acadobject))
(setq all-area 0)
(setq part-area 0)
(setq hole-area 0)
(setq use-area 0)
(setq width (getreal "\n请输入料款:"))
(setq pitch (getreal "\n请输入步距:"))
(setq num (getint "\n请输入每步料

数:"))
(setq all-area (* width pitch))
(setq name (car (entsel "\n请选择产品外形:")))
(while (= name nil)
(princ "\n没有选择到图元!继续选择:")
(setq name (car (entsel "\n请选择产品外形:")))
)
(setq vlxobj (vlax-ename->vla-object name))
(setq part-area (vlax-curve-getarea vlxobj))
(initget "Yes No")
(setq ju nil)
(setq ju (getkword "\n产品是否有内孔?(Yes/No):"))
(if (= ju nil) (setq ju "Yes"))
(if (= ju "Yes")
(progn
(princ "\n请选择内孔")
(setq ss (ssget))
(while (= ss nil)
(princ "\n没有选择到图元!继续选择:")
(setq ss (ssget))
)
(setq len nil)
(setq len (sslength ss))
(setq n 0)
(while (< n len)
(setq name (ssname ss n))
(setq vlxobj (vlax-ename->vla-object name))
(setq area (vlax-curve-getarea vlxobj))
(setq hole-area (+ hole-area area))
(setq n (1+ n))
)
)
)
(setq use-area (* (- part-area hole-area) num))
(setq rate (strcat (rtos (* (/ use-area all-area) 100) 2 3) "%"))
(princ)
)