明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2502|回复: 27

[提问] 如何统计矩形的长度和宽度,请各位来看看!

[复制链接]
发表于 2021-2-21 17:18 | 显示全部楼层 |阅读模式
本帖最后由 cj52000 于 2021-2-21 17:20 编辑

大家新年好!五金模具设计中为了防呆,防止零件装错,会将腔体做成大小不一样的矩形(或有圆角C角的矩形),但是当腔体数量太多难免会重复,造成零件大小一样装错,在晓东看到一个程序,可以统计矩形长宽,但是针对有圆角C角的矩形不适用,然后并形成表格,这样可以一眼看出来哪些矩形的长度是重复的,哪位朋友有类似的程序,就是统计矩形(带圆角C角的矩形)的长度就好,谢谢! (五金设计的同行也可分享下在腔体太多的情况下如何更快速的防呆)






"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2021-3-4 15:53 | 显示全部楼层
cj52000 发表于 2021-3-4 10:33
兄台能不能发出来试用下,谢啦
  1. (defun c:te( / co ent lst ss wus all ram ram2)

  2.   (defun ram( e / a d e)
  3.     (setq d (* 0.05 (distance (car e) (last e)))
  4.           e (mapcar '(lambda (x y )
  5.                         (polar x (dtr y) d)
  6.              )
  7.              e
  8.              '(225 135 315 45)
  9.       )  
  10.           e (list (nth 1 e) (nth 3 e) (nth 2 e) (car e))         
  11.           a (mapcar '(lambda (x y / i l)
  12.                      (setq i 1
  13.                            l '()
  14.                       )
  15.              (repeat(fix (sam_round (/ (distance x y)d) 1))
  16.                  (setq l (append l (list (polar x (angle x y) (* i d))))
  17.                        i (1+ i)
  18.                  )   
  19.              )
  20.              (cons x (Sam_lst_1-n (1- (length l)) l))
  21.         )
  22.         e
  23.         (append (cdr e) (list (car e)))
  24.       )  
  25.     a (apply  'append a)
  26.     a (mapcar 'sam_3d2d a)  
  27.     e (* d 0.5 (tan (dtr 27.5)))
  28.     e (- (/ e d 0.5))
  29.     d (mapcar '(lambda (x )                    
  30.             e
  31.            )
  32.         a        
  33.        )
  34.    )         
  35.    (sam_put (sam_make_pline a d 1 "Defpoints" "DIVIDE" 11)(list (list 48 0.05)))   
  36.   );ram
  37.   
  38.   
  39.    (defun ram2(lst all / base box cen co dat ent la la_ent tem)  
  40.     (while (> (length lst) 1)
  41.      (setq ent(car lst)
  42.          lst (cdr lst)
  43.          dat (mapcar  '(lambda (x)               
  44.                 (list (vla-get-Length (vlax-ename->vla-object (handent x)));长度
  45.                   (vla-get-Area (vlax-ename->vla-object (handent x)))  ;面积
  46.                    x
  47.                  )                    
  48.               )  
  49.              lst
  50.           )
  51.      )
  52.     (setq ent (handent ent)
  53.         co (vla-get-Length (vlax-ename->vla-object ent));长度
  54.         la (vla-get-Area (vlax-ename->vla-object ent))  ;面积
  55.         dat(vl-remove-if-not  '(lambda (x)                     
  56.                      (and                           
  57.                        (equal (nth 0 x) co 1e-6)  ;长度
  58.                        (equal (nth 1 x) la 1e-6)  ;面积
  59.                      )
  60.                     )                    
  61.              dat
  62.           )
  63.      
  64.      
  65.     )
  66.     (and dat
  67.        (setq dat (mapcar  '(lambda (x / n m o)
  68.                 (setq o (vlax-ename->vla-object(handent (nth 2 x)))                    
  69.                     m '()
  70.                     n 0
  71.                  )
  72.                  (repeat (fix(vlax-curve-getEndParam o))
  73.                    (setq m (append m
  74.                             (list (- (vlax-curve-getdistatparam o (1+ n))(vlax-curve-getdistatparam o n)))
  75.                         )
  76.                        n (1+ n)
  77.                    )            
  78.                  );repeat
  79.                  (if (sam_PlineCCW (handent (nth 2 x)))
  80.                    (list (nth 2 x) m)
  81.                    (list (nth 2 x) (reverse m))
  82.                  )   
  83.               )  
  84.                dat
  85.             )      
  86.        )
  87.       (setq tem (vlax-ename->vla-object ent)      
  88.           la '()
  89.           cen 0
  90.        )
  91.        (repeat (fix(vlax-curve-getEndParam tem))
  92.          (setq la (append la
  93.                   (list (- (vlax-curve-getdistatparam tem (1+ cen))(vlax-curve-getdistatparam tem cen)))
  94.               )
  95.              cen (1+ cen)
  96.          )            
  97.        );repeat
  98.       (setq la (if (sam_PlineCCW ent)
  99.               la
  100.               (reverse la)
  101.             )
  102.       )
  103.       (setq dat(vl-remove-if-not  '(lambda (x / n m o)                     
  104.                       (setq o (nth 1 x)
  105.                         m '()
  106.                         n 0   
  107.                       )
  108.                      (repeat (length la)
  109.                        (setq m (append m
  110.                                 (list (equal la o 1e-6)) ;长度list
  111.                             )
  112.                            n (1+ n)
  113.                            o (append (cdr o) (list (car o)))                       
  114.                        )            
  115.                      )
  116.                     (vl-remove nil m)
  117.                     )                    
  118.             dat
  119.           )
  120.       )
  121.     ) ;and
  122.    
  123.     (if dat
  124.       (progn
  125.        (setq base (sam_getbox ent 0.0 t)
  126.            base (sam_midpt_2p (car base)(last base))
  127.            la_ent (entlast)
  128.         )      
  129.       (foreach x dat
  130.          (setq lst (vl-remove (nth 0 x) lst)
  131.              tem (handent (nth 0 x))
  132.              box (sam_getbox tem 0.0 t)
  133.              cen (sam_midpt_2p (car box)(last box))   
  134.           )   
  135.           (and (> (distance base cen) 1e-6);not same
  136.              (progn
  137.                (setq cen (sam_Bu2Arc base cen 0.3));=> (<centre> <start angle> <end angle> <radius>)  
  138.                (vl-cmdf "-layer" "on" "Defpoints" "")
  139.                (vl-cmdf "-layer" "on" "0" "")               
  140.                (sam_put (sam_make_arc (car cen) (last cen) (cadr cen)(caddr cen) "Defpoints" 11 "DIVIDE")
  141.                   (list (list 48 0.05))
  142.                )
  143.                (ram (sam_getbox tem 0.0 t))               
  144.             )
  145.           )         
  146.        )
  147.         (sam_make_txt "c" base  3.0 0 (strcat "(" (itoa(1+(length dat)))")") 0.7 "Defpoints" 11)     
  148.         (princ(strcat  "\n    Find same insert = " (itoa(length dat)) " EA"))  
  149.         (vl-cmdf "-group" "create" "*" "" (last_ent la_ent) "")      
  150.        );pr     
  151.        (princ"\n    No find same intsert.")
  152.     );if
  153.     (setq lst (if all lst nil))
  154.     );while >1
  155.   );ram2
  156.      

  157.     (lt:error-init (list '("cmdecho" 0 "osmode" 0) 1 nil))
  158.     (if (setq wus(zerop(getvar "WORLDUCS")))(vl-cmdf "ucs" "w"))

  159.      (if (setq ss (cadr (ssgetfirst)))
  160.     (setq ent (ssname ss (1- (sslength ss)))
  161.           all nil                             ;;;nil = one sample   t = all same
  162.     )
  163.   )
  164.   (if (not(and ent (wcmatch (sam_dxf ent 0)"*POLYLINE")))
  165.     (setq ent nil
  166.           ent (sam_entsel "\n   Select a sample:"
  167.                '((0 . "LWPOLYLINE")) NIL
  168.          )
  169.         ent (car ent)  
  170.         all t
  171.     )      
  172.   )   
  173.    (setq co (sam_dxf 62 ent)     
  174.          lst (list '(0 . "LWPOLYLINE") (cons 8 (sam_dxf 8 ent)))         
  175.          lst (if co (append lst (list(cons 62 co))) lst)
  176.          ss (ssget "a" lst)
  177.          ent (sam_dxf 5 ent)
  178.          lst (sam_ss2hand ss)         
  179.          co (mapcar  '(lambda (x)            
  180.             (sam_del_repeat_pt (handent x))
  181.                     (sam_del_repeat_line (handent x))            
  182.             
  183.                     )  
  184.                    lst
  185.               )
  186.           lst (vl-remove ent lst)
  187.           lst (append (list ent) lst)  
  188.    )
  189.    (ram2 lst all)
  190.   (if wus(vl-cmdf "ucs" "p"))
  191.    (lt:error-restore)
  192.    (and(= (getvar "osmode") 0)(setvar "osmode" 39))  
  193.   (princ)
  194. )
上不了附件,贴不了。
发表于 2021-2-22 06:37 | 显示全部楼层
本帖最后由 vitalgg 于 2021-2-24 21:32 编辑

我猜你要的这种吧

调用了其它函数库,不能直接用。安装 @lisp 基础函数库 后可以运行以下代码。 http://atlisp.cn

对矩形也没有进行判断。 只要是8个点的多段线,都会列出。需要加我在上面说的条件。
视频演示http://atlisp.cn/package-info?name=list-rec-wxh&edition=stable

  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 这是使用开发工具 dev-tools 自动创建的程序源文件
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;; 定义配置项 'list-rec-wxh:first 用于 应用包 list-rec-wxh 的 第一个配置项 first
  4. ;; (@:get-config 'list-rec-wxh:first) ;; 获取配置顶的值
  5. ;; (@:set-config 'list-rec-wxh:first  "新设的值") ;; 设置配置顶的值
  6. ;; 向系统中添加菜单
  7. (@:add-menu "统计" "正交矩形宽高表" "(list-rec-wxh:draw)" )

  8. (defun @:get-lwpoints (en0 / ddlist dd1 tmplist )
  9.   "生成多段线的点序"
  10.   (setq ddlist nil)
  11.   (setq tmplist (entget en0))
  12.   (repeat
  13.    (cdr (assoc 90 (entget en0))) ;;计算节点数
  14.    (setq dd1 (cdr (assoc 10 tmplist))) ;;取顶点数据
  15.    (setq tmplist (member (assoc 10 tmplist) tmplist))
  16.    (setq tmplist (cdr tmplist))
  17.    (setq ddlist (append ddlist (list dd1) )) ;;下一个顶点
  18.    )
  19.   )
  20. (defun list-rec-wxh:draw ( / recs en% en0 pts pt1 i% tmp-pts result-pts area% angle%)
  21.   (@:help (strcat "统计有圆角或倒角的矩形的长宽并形成列表"))
  22.   (setq recs (ssget '((0 . "LWPOLYLINE")
  23.                       (-4  . "<AND")
  24.                       (-4 . ">=")(90 . 4)
  25.                       (-4 . "<=")(90 . 8)
  26.                       (-4 . "AND>"))))
  27.   (setq en% 0)
  28.   (setq pt1 (getpoint "请点取列表位置: "))
  29.   (entity:make-text
  30.    (format nil "rectang   width               height  ~%")
  31.    pt1 3.5 0 0.8 0 13)
  32.   (while (< en% (sslength recs))
  33.     (setq en0 (ssname recs en%))
  34.     (setq pts (@:get-lwpoints en0))
  35.     ;; 坐标变换直到面积最小
  36.     (setq i% 0)
  37.     (setq tmp-pts pts)
  38.     (setq result-pts pts)
  39.     (setq area% (* (- (apply 'max (mapcar 'car pts))
  40.                       (apply 'min (mapcar 'car pts))
  41.                       )
  42.                    (- (apply 'max (mapcar 'cadr pts))
  43.                       (apply 'min (mapcar 'cadr pts))
  44.                       )))
  45.     (while (< i% 4)
  46.       (setq angle% (- (angle (nth i% pts)(nth (1+ i%) pts))))
  47.       (setq tmp-pts (mapcar '(lambda (x) (m:coordinate-rotate x angle%)) pts))
  48.       (if  (> area% (* (- (apply 'max (mapcar 'car tmp-pts))
  49.                           (apply 'min (mapcar 'car tmp-pts))
  50.                           )
  51.                        (- (apply 'max (mapcar 'cadr tmp-pts))
  52.                           (apply 'min (mapcar 'cadr tmp-pts))
  53.                           )))
  54.            (progn
  55.              (setq result-pts tmp-pts)
  56.              (setq area%  (* (- (apply 'max (mapcar 'car tmp-pts))
  57.                                 (apply 'min (mapcar 'car tmp-pts))
  58.                                 )
  59.                              (- (apply 'max (mapcar 'cadr tmp-pts))
  60.                                 (apply 'min (mapcar 'cadr tmp-pts))
  61.                                 )))))
  62.       (setq i% (1+ i%)))

  63.     (entity:make-text
  64.      (format nil " ~d   ~15f  ~15f ~%"
  65.              (1+ en%)
  66.              (min (- (apply 'max (mapcar 'car result-pts))
  67.                      (apply 'min (mapcar 'car result-pts))
  68.                      )
  69.                   (- (apply 'max (mapcar 'cadr result-pts))
  70.                      (apply 'min (mapcar 'cadr result-pts))
  71.                      ))
  72.              (max (- (apply 'max (mapcar 'car result-pts))
  73.                      (apply 'min (mapcar 'car result-pts))
  74.                      )
  75.                   (- (apply 'max (mapcar 'cadr result-pts))
  76.                      (apply 'min (mapcar 'cadr result-pts))
  77.                      ))
  78.              )
  79.      (polar pt1 (* 1.5 pi) (* (1+ en%) 5)) 3.5 0 0.8 0 13)
  80.     (entity:make-leader (nth 0 pts) (polar pt1 (* 1.5 pi) (* (1+ en%) 5)))
  81.     (setq en% (1+ en%))
  82.     ))




发表于 2021-8-13 14:57 | 显示全部楼层
yoyoho 发表于 2021-3-6 17:42
谢谢,帮传一份

可以到http://cadplus.ys168.com/下载我的工具箱,子函数懒得一个一个拆出了,
已经做成三个功能:
1、预先选一个多义线,仅仅是执行这个多义线的镶件异同防呆检查,也可以方便查找镶件
2、没有选择,执行下一个样本同色同图层的所有多义线镶件异同防呆检查,适合组立图完成检查后分模
3、选择一个镶件外形或者剪口基准,再选择要复制的图元,自动复制到匹配的镶件上
 楼主| 发表于 2021-2-21 17:20 | 显示全部楼层
怎么图片上传不了呢,才13K
发表于 2021-2-21 19:14 | 显示全部楼层
4个角的倒角圆角都一样吗?
一样的话特征 ,8个顶点的多段线,顶点的距离 1~5=4~8 ;2~6=3~7。
长度 为 1~4 宽 2~7。
发表于 2021-2-21 21:08 | 显示全部楼层
可上传个dwg看看
发表于 2021-2-21 23:57 | 显示全部楼层
金牌会员都传不上图片啊,看来是论坛出问题了么?
 楼主| 发表于 2021-2-22 08:47 | 显示全部楼层
vitalgg 发表于 2021-2-21 19:14
4个角的倒角圆角都一样吗?
一样的话特征 ,8个顶点的多段线,顶点的距离 1~5=4~8 ;2~6=3~7。
长度 为 1 ...

谢谢关注,这个倒角有圆角有C角,等会上传个DWG
 楼主| 发表于 2021-2-22 08:47 | 显示全部楼层

好的,马上上传
 楼主| 发表于 2021-2-22 08:49 | 显示全部楼层
vitalgg 发表于 2021-2-22 06:37
我猜你要的这种吧

调用了其它函数库,不能直接用。安装 @lisp 基础函数库 后可以运行以下代码。 http:/ ...

是的,是这个效果,就是要统计矩形的长和宽,可能是我没有表述清楚,工作中除了8个点的多段线还有4个点,5个点的,我上传个DWG,谢谢!
 楼主| 发表于 2021-2-22 09:25 | 显示全部楼层
大家好,以下为上传的附件,请查阅,谢谢!

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 17:11 , Processed in 0.283396 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表