如何统计矩形的长度和宽度，请各位来看看！

690994 · 发表于 2021-3-2 13:49:00

刚刚试着做了一个检查入子的小程序，伪码就不发了，思路就是点选一个入子外形，按入子的颜色线型图层过滤选择所有图元，再根据长度面积筛选一遍，相同的图元再指示出来。没有进行排除镜像的图元，如果要将镜像的也去掉，可以逐段长度对比进行

cj52000 · 发表于 2021-3-4 10:33:51

690994 发表于 2021-3-2 13:49
刚刚试着做了一个检查入子的小程序，伪码就不发了，思路就是点选一个入子外形，按入子的颜色线型图层过滤选 ...

兄台能不能发出来试用下，谢啦

690994 · 发表于 2021-3-4 15:53:08

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" base 3.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)
)

(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" base  3.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) 
)

上不了附件，贴不了。

cj52000 · 发表于 2021-3-4 19:27:59

690994 发表于 2021-3-4 15:53
上不了附件，贴不了。

谢谢，下来看看

690994 · 发表于 2021-3-5 15:47:06

cj52000 发表于 2021-3-4 19:27
谢谢，下来看看

子函数上传不了，需要可以邮件给你

cj52000 · 发表于 2021-3-6 14:12:30

690994 发表于 2021-3-5 15:47
子函数上传不了，需要可以邮件给你

谢谢，帮传一份 283191340@qq.com

yoyoho · 发表于 2021-3-6 17:42:15

谢谢，帮传一份yoyo86.ho@msa.hinet.net

690994 · 发表于 2021-8-13 14:57:04

yoyoho 发表于 2021-3-6 17:42
谢谢，帮传一份

可以到http://cadplus.ys168.com/下载我的工具箱，子函数懒得一个一个拆出了,
已经做成三个功能：
1、预先选一个多义线，仅仅是执行这个多义线的镶件异同防呆检查,也可以方便查找镶件
2、没有选择，执行下一个样本同色同图层的所有多义线镶件异同防呆检查,适合组立图完成检查后分模
3、选择一个镶件外形或者剪口基准，再选择要复制的图元，自动复制到匹配的镶件上

账号		自动登录	找回密码
密码			注册

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