如何统计矩形的长度和宽度，请各位来看看！
本帖最后由 cj52000 于 2021-2-21 17:20 编辑大家新年好！五金模具设计中为了防呆，防止零件装错，会将腔体做成大小不一样的矩形（或有圆角C角的矩形），但是当腔体数量太多难免会重复，造成零件大小一样装错，在晓东看到一个程序，可以统计矩形长宽，但是针对有圆角C角的矩形不适用，然后并形成表格，这样可以一眼看出来哪些矩形的长度是重复的，哪位朋友有类似的程序，就是统计矩形（带圆角C角的矩形）的长度就好，谢谢！ （五金设计的同行也可分享下在腔体太多的情况下如何更快速的防呆）
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)
)
上不了附件，贴不了。
本帖最后由 vitalgg 于 2021-2-24 21:32 编辑
我猜你要的这种吧
http://atlisp.cn/static/list-rec.gif
调用了其它函数库，不能直接用。安装 @lisp 基础函数库 后可以运行以下代码。 http://atlisp.cn
对矩形也没有进行判断。 只要是8个点的多段线，都会列出。需要加我在上面说的条件。
视频演示http://atlisp.cn/package-info?name=list-rec-wxh&edition=stable
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 这是使用开发工具 dev-tools 自动创建的程序源文件
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 定义配置项 'list-rec-wxh:first 用于 应用包 list-rec-wxh 的 第一个配置项 first
;; (@:get-config 'list-rec-wxh:first) ;; 获取配置顶的值
;; (@:set-config 'list-rec-wxh:first"新设的值") ;; 设置配置顶的值
;; 向系统中添加菜单
(@:add-menu "统计" "正交矩形宽高表" "(list-rec-wxh:draw)" )
(defun @:get-lwpoints (en0 / ddlist dd1 tmplist )
"生成多段线的点序"
(setq ddlist nil)
(setq tmplist (entget en0))
(repeat
(cdr (assoc 90 (entget en0))) ;;计算节点数
(setq dd1 (cdr (assoc 10 tmplist))) ;;取顶点数据
(setq tmplist (member (assoc 10 tmplist) tmplist))
(setq tmplist (cdr tmplist))
(setq ddlist (append ddlist (list dd1) )) ;;下一个顶点
)
)
(defun list-rec-wxh:draw ( / recs en% en0 pts pt1 i% tmp-pts result-pts area% angle%)
(@:help (strcat "统计有圆角或倒角的矩形的长宽并形成列表"))
(setq recs (ssget '((0 . "LWPOLYLINE")
(-4. "<AND")
(-4 . ">=")(90 . 4)
(-4 . "<=")(90 . 8)
(-4 . "AND>"))))
(setq en% 0)
(setq pt1 (getpoint "请点取列表位置: "))
(entity:make-text
(format nil "rectang width height~%")
pt1 3.5 0 0.8 0 13)
(while (< en% (sslength recs))
(setq en0 (ssname recs en%))
(setq pts (@:get-lwpoints en0))
;; 坐标变换直到面积最小
(setq i% 0)
(setq tmp-pts pts)
(setq result-pts pts)
(setq area% (* (- (apply 'max (mapcar 'car pts))
(apply 'min (mapcar 'car pts))
)
(- (apply 'max (mapcar 'cadr pts))
(apply 'min (mapcar 'cadr pts))
)))
(while (< i% 4)
(setq angle% (- (angle (nth i% pts)(nth (1+ i%) pts))))
(setq tmp-pts (mapcar '(lambda (x) (m:coordinate-rotate x angle%)) pts))
(if(> area% (* (- (apply 'max (mapcar 'car tmp-pts))
(apply 'min (mapcar 'car tmp-pts))
)
(- (apply 'max (mapcar 'cadr tmp-pts))
(apply 'min (mapcar 'cadr tmp-pts))
)))
(progn
(setq result-pts tmp-pts)
(setq area%(* (- (apply 'max (mapcar 'car tmp-pts))
(apply 'min (mapcar 'car tmp-pts))
)
(- (apply 'max (mapcar 'cadr tmp-pts))
(apply 'min (mapcar 'cadr tmp-pts))
)))))
(setq i% (1+ i%)))
(entity:make-text
(format nil " ~d ~15f~15f ~%"
(1+ en%)
(min (- (apply 'max (mapcar 'car result-pts))
(apply 'min (mapcar 'car result-pts))
)
(- (apply 'max (mapcar 'cadr result-pts))
(apply 'min (mapcar 'cadr result-pts))
))
(max (- (apply 'max (mapcar 'car result-pts))
(apply 'min (mapcar 'car result-pts))
)
(- (apply 'max (mapcar 'cadr result-pts))
(apply 'min (mapcar 'cadr result-pts))
))
)
(polar pt1 (* 1.5 pi) (* (1+ en%) 5)) 3.5 0 0.8 0 13)
(entity:make-leader (nth 0 pts) (polar pt1 (* 1.5 pi) (* (1+ en%) 5)))
(setq en% (1+ en%))
))
yoyoho 发表于 2021-3-6 17:42
谢谢，帮传一份
可以到http://cadplus.ys168.com/下载我的工具箱，子函数懒得一个一个拆出了,
已经做成三个功能：
1、预先选一个多义线，仅仅是执行这个多义线的镶件异同防呆检查,也可以方便查找镶件
2、没有选择，执行下一个样本同色同图层的所有多义线镶件异同防呆检查,适合组立图完成检查后分模
3、选择一个镶件外形或者剪口基准，再选择要复制的图元，自动复制到匹配的镶件上 怎么图片上传不了呢，才13K:(:(:( 4个角的倒角圆角都一样吗？
一样的话特征 ，8个顶点的多段线，顶点的距离 1~5=4~8 ；2~6=3~7。
长度 为 1~4 宽 2~7。 可上传个dwg看看 金牌会员都传不上图片啊，看来是论坛出问题了么？ vitalgg 发表于 2021-2-21 19:14
4个角的倒角圆角都一样吗？
一样的话特征 ，8个顶点的多段线，顶点的距离 1~5=4~8 ；2~6=3~7。
长度 为 1 ...
谢谢关注，这个倒角有圆角有C角，等会上传个DWG 革天明 发表于 2021-2-21 21:08
可上传个dwg看看
好的，马上上传 vitalgg 发表于 2021-2-22 06:37
我猜你要的这种吧
调用了其它函数库，不能直接用。安装 @lisp 基础函数库 后可以运行以下代码。 http:/ ...
是的，是这个效果，就是要统计矩形的长和宽，可能是我没有表述清楚，工作中除了8个点的多段线还有4个点，5个点的，我上传个DWG，谢谢！ 大家好，以下为上传的附件，请查阅，谢谢！