刚刚试着做了一个检查入子的小程序，伪码就不发了，思路就是点选一个入子外形，按入子的颜色线型图层过滤选择所有图元，再根据长度面积筛选一遍，相同的图元再指示出来。没有进行排除镜像的图元，如果要将镜像的也去掉，可以逐段长度对比进行
690994 发表于 2021-3-2 13:49
刚刚试着做了一个检查入子的小程序，伪码就不发了，思路就是点选一个入子外形，按入子的颜色线型图层过滤选 ...
兄台能不能发出来试用下，谢啦:$
cj52000 发表于 2021-3-4 10:33
兄台能不能发出来试用下，谢啦
(defun c:te( / co ent lst ss wus all ram ram2)
(defun ram( e / a d e)
(setq d (* 0.05 (distance (car e) (last e)))
e (mapcar '(lambda (x y )
(polar x (dtr y) d)
)
e
'(225 135 315 45)
)
e (list (nth 1 e) (nth 3 e) (nth 2 e) (car e))
a (mapcar '(lambda (x y / i l)
(setq i 1
l '()
)
(repeat(fix (sam_round (/ (distance x y)d) 1))
(setq l (append l (list (polar x (angle x y) (* i d))))
i (1+ i)
)
)
(cons x (Sam_lst_1-n (1- (length l)) l))
)
e
(append (cdr e) (list (car e)))
)
a (apply'append a)
a (mapcar 'sam_3d2d a)
e (* d 0.5 (tan (dtr 27.5)))
e (- (/ e d 0.5))
d (mapcar '(lambda (x )
e
)
a
)
)
(sam_put (sam_make_pline a d 1 "Defpoints" "DIVIDE" 11)(list (list 48 0.05)))
);ram
(defun ram2(lst all / base box cen co dat ent la la_ent tem)
(while (> (length lst) 1)
(setq ent(car lst)
lst (cdr lst)
dat (mapcar'(lambda (x)
(list (vla-get-Length (vlax-ename->vla-object (handent x)));长度
(vla-get-Area (vlax-ename->vla-object (handent x)));面积
x
)
)
lst
)
)
(setq ent (handent ent)
co (vla-get-Length (vlax-ename->vla-object ent));长度
la (vla-get-Area (vlax-ename->vla-object ent));面积
dat(vl-remove-if-not'(lambda (x)
(and
(equal (nth 0 x) co 1e-6);长度
(equal (nth 1 x) la 1e-6);面积
)
)
dat
)
)
(and dat
(setq dat (mapcar'(lambda (x / n m o)
(setq o (vlax-ename->vla-object(handent (nth 2 x)))
m '()
n 0
)
(repeat (fix(vlax-curve-getEndParam o))
(setq m (append m
(list (- (vlax-curve-getdistatparam o (1+ n))(vlax-curve-getdistatparam o n)))
)
n (1+ n)
)
);repeat
(if (sam_PlineCCW (handent (nth 2 x)))
(list (nth 2 x) m)
(list (nth 2 x) (reverse m))
)
)
dat
)
)
(setq tem (vlax-ename->vla-object ent)
la '()
cen 0
)
(repeat (fix(vlax-curve-getEndParam tem))
(setq la (append la
(list (- (vlax-curve-getdistatparam tem (1+ cen))(vlax-curve-getdistatparam tem cen)))
)
cen (1+ cen)
)
);repeat
(setq la (if (sam_PlineCCW ent)
la
(reverse la)
)
)
(setq dat(vl-remove-if-not'(lambda (x / n m o)
(setq o (nth 1 x)
m '()
n 0
)
(repeat (length la)
(setq m (append m
(list (equal la o 1e-6)) ;长度list
)
n (1+ n)
o (append (cdr o) (list (car o)))
)
)
(vl-remove nil m)
)
dat
)
)
) ;and
(if dat
(progn
(setq base (sam_getbox ent 0.0 t)
base (sam_midpt_2p (car base)(last base))
la_ent (entlast)
)
(foreach x dat
(setq lst (vl-remove (nth 0 x) lst)
tem (handent (nth 0 x))
box (sam_getbox tem 0.0 t)
cen (sam_midpt_2p (car box)(last box))
)
(and (> (distance base cen) 1e-6);not same
(progn
(setq cen (sam_Bu2Arc base cen 0.3));=> (<centre> <start angle> <end angle> <radius>)
(vl-cmdf "-layer" "on" "Defpoints" "")
(vl-cmdf "-layer" "on" "0" "")
(sam_put (sam_make_arc (car cen) (last cen) (cadr cen)(caddr cen) "Defpoints" 11 "DIVIDE")
(list (list 48 0.05))
)
(ram (sam_getbox tem 0.0 t))
)
)
)
(sam_make_txt "c" base3.0 0 (strcat "(" (itoa(1+(length dat)))")") 0.7 "Defpoints" 11)
(princ(strcat"\n Find same insert = " (itoa(length dat)) " EA"))
(vl-cmdf "-group" "create" "*" "" (last_ent la_ent) "")
);pr
(princ"\n No find same intsert.")
);if
(setq lst (if all lst nil))
);while >1
);ram2
(lt:error-init (list '("cmdecho" 0 "osmode" 0) 1 nil))
(if (setq wus(zerop(getvar "WORLDUCS")))(vl-cmdf "ucs" "w"))
(if (setq ss (cadr (ssgetfirst)))
(setq ent (ssname ss (1- (sslength ss)))
all nil ;;;nil = one sample t = all same
)
)
(if (not(and ent (wcmatch (sam_dxf ent 0)"*POLYLINE")))
(setq ent nil
ent (sam_entsel "\n Select a sample:"
'((0 . "LWPOLYLINE")) NIL
)
ent (car ent)
all t
)
)
(setq co (sam_dxf 62 ent)
lst (list '(0 . "LWPOLYLINE") (cons 8 (sam_dxf 8 ent)))
lst (if co (append lst (list(cons 62 co))) lst)
ss (ssget "a" lst)
ent (sam_dxf 5 ent)
lst (sam_ss2hand ss)
co (mapcar'(lambda (x)
(sam_del_repeat_pt (handent x))
(sam_del_repeat_line (handent x))
)
lst
)
lst (vl-remove ent lst)
lst (append (list ent) lst)
)
(ram2 lst all)
(if wus(vl-cmdf "ucs" "p"))
(lt:error-restore)
(and(= (getvar "osmode") 0)(setvar "osmode" 39))
(princ)
)
上不了附件，贴不了。
690994 发表于 2021-3-4 15:53
上不了附件，贴不了。
谢谢，下来看看
cj52000 发表于 2021-3-4 19:27
谢谢，下来看看
子函数上传不了，需要可以邮件给你
690994 发表于 2021-3-5 15:47
子函数上传不了，需要可以邮件给你
谢谢，帮传一份 283191340@qq.com
谢谢，帮传一份yoyo86.ho@msa.hinet.net
yoyoho 发表于 2021-3-6 17:42
谢谢，帮传一份
可以到http://cadplus.ys168.com/下载我的工具箱，子函数懒得一个一个拆出了,
已经做成三个功能：
1、预先选一个多义线，仅仅是执行这个多义线的镶件异同防呆检查,也可以方便查找镶件
2、没有选择，执行下一个样本同色同图层的所有多义线镶件异同防呆检查,适合组立图完成检查后分模
3、选择一个镶件外形或者剪口基准，再选择要复制的图元，自动复制到匹配的镶件上