(defun bishe ()
(vl-load-com)
(setq
n-scale (getint
"输入结合剂尺寸与磨粒尺寸比例:(5,10,15)"
)
)
(setq d-grind (getint "磨粒直径大小="))
(setq density (getreal "金刚石砂轮中金刚石密度(%):"))
; (setq cutting-high (getint "输入需要切削的高度:"))
(setq cutting-high (/ d-grind 2))
(setq b (* d-grind n-scale))
(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.0 0.0))
(setq pb (list b b b))
(command "box" pa pb)
(setq binding (entlast))
(setq binding-index (entget binding))
(setq d1 (assoc 62 binding-index))
(setq d2 (cons 62 4))
(setq binding-index (cons d2 binding-index))
(entmod binding-box)
(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选择集
(setq grinds (ssget "L")) ;建立grinds选择集
(
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 pa (list 0.0 0.0 0.0))
(setq pb (list b b b))
(command "box" pa pb)
(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 pc1 (list 0 0 cutting-high))
(setq pc2 (list b b cutting-high))
(setq pc3 (list 0 b cutting-high))
(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 0)
;将不在剩余结合剂上的磨粒以及在结合剂上的体积占比不到25%的磨粒去除
;-----------------------------------------------
(while (< i m-number)
(setq grind0 (ssname grind-data i))
(vlax-Invoke-method
(vlax-ename->vla-object grind0)
'GETBoundingBox
'a
'b
)
(setq p-low (vlax-safearray->list a))
(setq p-high (vlax-safearray->list b))
(setq z-low (caddr p-low)) ;磨粒最低点z坐标
(setq z-high (caddr p-high)) ;磨粒最高点z坐标
;如果最低点高于cutting-high,去除磨粒
(if (> z-low cutting-high)
(command "erase" grind0 "")
;--------------------------------
;否则,判断是否需要产生凹槽
(progn
(command "copy" grind0 "" (list 0 0 0) (list 0 0 0))
(setq a-grind (entlast))
(setq pa (list 0.0 0.0 0.0))
(setq pb (list b b cutting-high))
(command "box" pa pb)
(setq a-box (entlast))
(command "intersect" a-grind a-box "")
(setq intersection (entlast))
(setq
v-inter
(vla-get-Volume (vlax-ename->vla-object intersection))
)
; 产生凹槽
;----------------------------------
(if (< v-inter (* 0.25 v-moli))
(command "subtract" binding "" grind0 "")
)
(if (> z-high cutting-high)
(setq xiangdui-high (- z-high cutting-high))
(setq total-high (+ total-high xiangdui-high))
)
(command "erase" intersection "")
)
)
(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))
)
上面是我的代码
然后这个图片是我的流程图,可是结果并不对,希望大神指教