(defun kkk ()
(vl-load-com)
(setq
n-scale (getint
"输入结合剂尺寸与磨粒尺寸比例：（5,10,15）"
)
)
(setq d-grind (getint "磨粒直径大小="))
(setq density (getreal "金刚石砂轮中金刚石密度（%）："))
; (setq cutting-high (getint "输入需要切削的高度："))
(setq b (* d-grind n-scale))
(setq ch (/ b 2))
(setq v-box (* b b b)) ;求结合剂总体积
(setq v-max (* (/ density 400) v-box));求金刚石砂轮中金刚石的最大总体积
(setq v-total 0.0)
(setq v-single 0.0)
;限定区域
;-----------------------------------
(setq pa (list 0 0 0))
(setq pb (list b b b))
(command "box" pa pb)
(setq binding (entlast))
(setq p0 (list 0.0 0.0 0.0))
(setq locations (list p0))
(setq m (length locations))
;构造磨粒
;------------------------------------
(setq p1 (list (/ d-grind 2) (/ d-grind 2) (/ d-grind 2)))
(setq p2 (list (- (/ d-grind 2)) (- (/ d-grind 2)) (- (/ d-grind 2))))
(command "box" p1 p2)
(setq grind (entlast))
;(setq j 0)
;(while (< j 2)
; (setq i 0)
; (while (< i 4)
; (setq pt1 (list (/ d-grind 2) 0 (/ d-grind 2)))
; (setq pt2 (list 0 (/ d-grind 2) (/ d-grind 2)))
; (setq pt3 (list (/ d-grind 2) (/ d-grind 2) 0.0))
; (command "slice" grind "" "3" pt1 pt2 pt3 p0)
; (setq grind (entlast))
; (command "rotate3D" grind "" p0 (list 0.0 0.0 1.0) 90)
; (setq i (+ 1 i))
; )
;(command "rotate3D" grind "" p0 (list 1.0 0.0 0.0) 180)
;(setq j (+ 1 j))
;)
;(setq grind (entlast))
(setq v-moli (vla-get-volume (vlax-ename->vla-object grind)))
;求磨粒体积
(setq grind-data (ssget "L")) ;建立grind-data选择集
(
while (<= v-total v-max)
(setq p0 (list 0.0 0.0 0.0))
(setq xzb (rd 0 b))
(setq yzb (rd 0 b))
(setq zzb (rd 0 b))
(setq p1 (list xzb yzb zzb))
(setq d-min (distance p1 pa))
;保证与之前所有生成的磨粒之间的距离
;----------------------------------
(
while (/= m 0)
(setq p-exist (nth (- m 1) locations))
(setq d-now (distance p1 p-exist))
(if (< d-now d-min)
(setq d-min d-now)
)
(setq m (- m 1))
)
;求得与之前所存在的点的最小距离
;-------------------------------------
(if (>= d-min (* 1.8 d-grind))
(progn
(setq locations (cons p1 locations))
(command "copy" grind "" (list 0 0 0) (list xzb yzb zzb))
; (setq grind-1 (entlast))
;空间旋转
;-------------------------------------
; (setq x (rd 0 1))
; (setq y (rd 0 1))
; (setq z (rd 0 1))
; (setq pr1 (list (+ xzb x) (+ yzb y) (+ zzb z)))
; (setq pr2 (list (- xzb x) (- yzb y) (- zzb z)))
; (setq ag (rd 0 360))
; (command "rotate3D" grind-1 "" pr1 pr2 ag)
;正方体内磨粒体积
;------------------------------------------
(setq eb0 (entlast))
(setq grind-data (ssadd eb0 grind-data))
;将磨粒加入grind-data选择集
;求单个磨粒与正方体的交集的体积
;----------------------------------------
(command "copy" eb0 "" (list 0 0 0) (list 0 0 0))
(setq eb1 (entlast))
(setq pa1 (list 0 0 0))
(setq pb1 (list b b b))
(command "box" pa1 pb1)
(setq ea (entlast))
(command "intersect" ea eb1 "")
(setq grind-in (entlast))
(setq
v-single (vla-get-Volume (vlax-ename->vla-object grind-in))
)
;---------------------------------------------
(setq v-total (+ v-total v-single))
(command "erase" grind-in "")
)
)
(setq m (length locations))
)
;切层
;-------------------------------
(setq grind-data (ssget "X"))
(setq pc1 (list 0 0 ch))
(setq pc2 (list b b ch))
(setq pc3 (list 0 b ch))
(setq pc0 (list 0 0 0))
(command "slice" binding "" "3" pc1 pc2 pc3 p0)
(setq binding (entlast))
(setq m-number (sslength grind-data))
(setq i 1)
;将不在剩余结合剂上的磨粒以及在结合剂上的体积占比不到25%的磨粒去除
;-----------------------------------------------
(while (< i m-number)
(setq grind0 (ssname grind-data i))
(vlax-Invoke-method (vlax-ename->vla-object grind0) 'GETBoundingBox 'a 'c )
(setq p-low (vlax-safearray->list a))
(setq p-high (vlax-safearray->list c))
(setq z-low (caddr p-low)) ;磨粒最低点z坐标
(setq z-high (caddr p-high)) ;磨粒最高点z坐标
;如果最低点高于cutting-high，去除磨粒
(if (> z-low ch)
(command "erase" grind0 "")
;--------------------------------
;否则，判断是否需要产生凹槽
(progn
(command "copy" grind0 "" (list 0 0 0) (list 0 0 0))
(setq a-grind (entlast))
(setq d (/ b 2))
(setq d2 (/ ch 2))
(command "box" "c" (list d d d2) (list 0 0 0))
(setq a-box (entlast))
(command "intersect" a-box a-grind "")
(if (= inter1 nil)
(progn
(princ dddddd)
)
(progn
(setq inter1 (entlast))
(setq v-inter (vla-get-volume (vlax-ename->vla-object inter1)))
(if (< v-inter (* 0.25 v-moli))
(command "subtract" binding "" grind0 "")
)
(if (> z-high ch)
(progn
(setq xiangdui-high (- z-high ch))
(setq total-high (+ total-high xiangdui-high))
)
)
)
)
; (command "erase" inter1 "")
)
)
(setq i (+ 1 i))
)
(command "erase" grind "")
(setq outside-high total-high)
(setq m (length locations))
(setvar "osmode" 1)
)
;随机数的生成
;-------------------------------------
(defun rd (n1 n2)
(repeat 3
(setq a (rnd0 n1 n2))
(while (= a (rnd0 n1 n2)) (setq a (rnd0 n1 n2)))
)
(setq a (rnd0 n1 n2))
)
(defun rnd0 (n1 n2)
(setq ra 66791
rb 17
nn 30
)
(setq imin (expt 2 31)
imax (1- imin)
)
(if (> n1 n2)
(setq n3 n1
n1 n2
n2 n3
)
)
(setq rn (atoi (substr (rtos (getvar "cdate") 2 7) 14)))
(repeat nn
(setq rn (+ (* rn ra) rb))
(if (minusp rn)
(setq rn (- rn imin))
)
)
(setq rn (rem rn imax))
(setq rn (/ rn imax 1.0))
(setq rn (+ (fix (* rn (1+ (- n2 n1)))) n1))
)
(setq v-inter (vla-get-volume (vlax-ename->vla-object inter1)))在这里报错vla-object参数为nil