如何快速查某一边长的矩形及三角形

yamjqq

有若干多义线画的三角形、矩形（边长均未标注）如何快速查找边长为349的三角形，边长160的矩形，为防止偏差容差默认为2。

e2002

就这么多还是有非常多？
如果就这么点，你还是直接标注后直接找出来用时更少。

yamjqq

图形非常多，通过查找标注尺寸的方法比较麻烦。

e2002

那就只好程序处理了。
获得 ss ， 遍历每个三角形和矩形对象， 计算边长，只要有 某个边长为 L+-2的，就计入一个 ssnew；
最后返回 ssnew

edata

1. ;;快速查找三角形边长
   
2. ;by edata @ mjtd.com 2015-8-2
   
3. (defun c:tt(/ ss ss2 en pts ds1 ds2 ds3 ds4 p1 p2 p3 p4)
   
4.   (setq ss2(ssadd))
   
5.   (if(setq ss(ssget '((0 . "lwpolyline"))))
   
6.     (while(setq en(ssname ss 0))
   
7.       (setq pts(sk_getpt en) p1 nil p2 nil p3 nil p4 nil)
   
8.       (setq pts(sk_removept pts 1e-6))
   
9.       (cond
   
10.         ((=(length pts) 3)
    
11.          (mapcar 'set '(p1 p2 p3) pts)
    
12.          (setq ds1(distance p1 p2)
    
13.                ds2(distance p2 p3)
    
14.                ds3(distance p3 p1)
    
15.                )         
    
16.          (if(or(equal 349 ds1  2)
    
17.                 (equal 349 ds2  2)
    
18.                 (equal 349 ds3 2)
    
19.                 )
    
20.            (setq ss2(ssadd en ss2))          
    
21.            )
    
22.          )
    
23.         ((=(length pts) 4)
    
24.          (mapcar 'set '(p1 p2 p3 p4) pts)
    
25.          (setq ds1(distance p1 p2)
    
26.                ds2(distance p2 p3)
    
27.                ds3(distance p3 p4)
    
28.                ds4(distance p4 p1)
    
29.                )         
    
30.          (if(or(equal 160 ds1 2)
    
31.                (equal 160 ds2 2)
    
32.                (equal 160 ds3 2)
    
33.                (equal 160 ds4 2)
    
34.                )
    
35.            (setq ss2(ssadd en ss2))
    
36.            )
    
37.          )
    
38.         )
    
39.       (setq ss(ssdel en ss))
    
40.       )
    
41.     )
    
42.   (if (and ss2 (> (sslength ss2 ) 0))
    
43.     (progn      
    
44.       (sssetfirst nil ss2)
    
45.       (vl-cmdf "regen")
    
46.       )
    
47.     )
    
48.   (princ)
    
49.   )
    
50. (defun sk_getpt(ent)
    
51.   (mapcar 'cdr (vl-remove-if-not  '(lambda(x)(= (car x) 10)) (entget ent)))
    
52.   )
    
53. (defun sk_removept (ptLst fuzz / pt1)
    
54.     (cond ((<= (length ptLst) 1) ptLst)
    
55.           (t
    
56.            (setq pt1 (car ptLst))
    
57.            (cons pt1
    
58.                  (vl-remove-if
    
59.                    '(lambda (x) (and(equal (car pt1) (car x) fuzz)
    
60.                                     (equal (cadr pt1) (cadr x) fuzz)
    
61.                                     )
    
62.                                     )
    
63.                    (sk_removept (cdr ptLst) fuzz)
    
64.                  )
    
65.            )
    
66.           )
    
67.     )
    
68.   )

;;快速查找三角形边长<br /> ;by edata @ mjtd.com 2015-8-2<br /> (defun c:tt(/ ss ss2 en pts ds1 ds2 ds3 ds4 p1 p2 p3 p4)<br />   (setq ss2(ssadd))<br />   (if(setq ss(ssget '((0 . "lwpolyline"))))<br />     (while(setq en(ssname ss 0))<br />       (setq pts(sk_getpt en) p1 nil p2 nil p3 nil p4 nil)<br />       (setq pts(sk_removept pts 1e-6))<br />       (cond<br />         ((=(length pts) 3)<br />          (mapcar 'set '(p1 p2 p3) pts)<br />          (setq ds1(distance p1 p2)<br />                ds2(distance p2 p3)<br />                ds3(distance p3 p1)<br />                )         <br />          (if(or(equal 349 ds1  2)<br />                 (equal 349 ds2  2)<br />                 (equal 349 ds3 2)<br />                 )<br />            (setq ss2(ssadd en ss2))           <br />            )<br />          )<br />         ((=(length pts) 4)<br />          (mapcar 'set '(p1 p2 p3 p4) pts)<br />          (setq ds1(distance p1 p2)<br />                ds2(distance p2 p3)<br />                ds3(distance p3 p4)<br />                ds4(distance p4 p1)<br />                )         <br />          (if(or(equal 160 ds1 2)<br />                (equal 160 ds2 2)<br />                (equal 160 ds3 2)<br />                (equal 160 ds4 2)<br />                )<br />            (setq ss2(ssadd en ss2))<br />            )<br />          )<br />         )<br />       (setq ss(ssdel en ss))<br />       )<br />     )<br />   (if (and ss2 (> (sslength ss2 ) 0))<br />     (progn      <br />       (sssetfirst nil ss2)<br />       (vl-cmdf "regen")<br />       )<br />     )<br />   (princ)<br />   )<br /> (defun sk_getpt(ent)<br />   (mapcar 'cdr (vl-remove-if-not  '(lambda(x)(= (car x) 10)) (entget ent)))<br />   )<br /> (defun sk_removept (ptLst fuzz / pt1)<br />     (cond ((<= (length ptLst) 1) ptLst)<br />           (t<br />            (setq pt1 (car ptLst))<br />            (cons pt1<br />                  (vl-remove-if<br />                    '(lambda (x) (and(equal (car pt1) (car x) fuzz)<br />                                     (equal (cadr pt1) (cadr x) fuzz)<br />                                     )<br />                                     )<br />                    (sk_removept (cdr ptLst) fuzz)<br />                  )<br />            )<br />           )<br />     )<br />   )

77077

用这个是否可以？未严格测试~~~

2. ;;功能] pline,lwpline各段长度 BY:qq181976640
   
3. ;;示例(setq lens (vlens (car (entsel))))
   
4. (defun vlens (e / i len1 len2 lst)
   
5.   (setq i 0 lst nil)
   
6.   (while (and (setq len1 (vlax-curve-getDistAtParam e i))
   
7.                     (setq len2 (vlax-curve-getDistAtParam e (setq i (1+ i))))
   
8.                  )
   
9.       (setq lst (cons (- len2 len1) lst))
   
10.     )
    
11.   (reverse lst)
    
12. )
    
13. ;;查找含有某一长度的多段线
    
14. (defun c:tt(/ len ss i ss2 en lens)
    
15.         (setq len (getreal "要查找的边长:"))
    
16.   (if (and (setq ss(ssget '((0 . "*POLYLINE"))))
    
17.                  (> (sslength ss) 0)
    
18.                  (setq i 0)
    
19.                  (setq ss2(ssadd))
    
20.                 )
    
21.     (while (setq en (ssname ss i))
    
22.       (setq lens (vlens en))
    
23.       (if (and
    
24.               (or(=(length lens)3)(=(length lens)4))
    
25.               (or (equal len (car lens) 0.1)
    
26.                      (equal len (cadr lens) 0.1)
    
27.                      (equal len (caddr lens) 0.1)
    
28.                      (equal len (cadddr lens) 0.1)
    
29.            ))
    
30.        (setq ss2 (ssadd en ss2))
    
31.        )
    
32.       (setq i (1+ i))
    
33.     )
    
34.    )
    
35.    (sssetfirst nil ss2)
    
36.    (princ)
    
37. )

;;功能] pline,lwpline各段长度 BY:qq181976640<br /> ;;示例(setq lens (vlens (car (entsel))))<br /> (defun vlens (e / i len1 len2 lst)<br />   (setq i 0 lst nil)<br />   (while (and (setq len1 (vlax-curve-getDistAtParam e i))<br />                     (setq len2 (vlax-curve-getDistAtParam e (setq i (1+ i))))<br />                  )<br />       (setq lst (cons (- len2 len1) lst))<br />     )<br />   (reverse lst)<br /> )<br /> ;;查找含有某一长度的多段线<br /> (defun c:tt(/ len ss i ss2 en lens)<br />         (setq len (getreal "要查找的边长:"))<br />   (if (and (setq ss(ssget '((0 . "*POLYLINE"))))<br />                  (> (sslength ss) 0)<br />                  (setq i 0)<br />                  (setq ss2(ssadd))<br />                 )<br />     (while (setq en (ssname ss i))<br />       (setq lens (vlens en))<br />       (if (and<br />               (or(=(length lens)3)(=(length lens)4))<br />               (or (equal len (car lens) 0.1)<br />                      (equal len (cadr lens) 0.1)<br />                      (equal len (caddr lens) 0.1)<br />                      (equal len (cadddr lens) 0.1)<br />            ))<br />        (setq ss2 (ssadd en ss2))<br />        )<br />       (setq i (1+ i))<br />     )<br />    )<br />    (sssetfirst nil ss2)<br />    (princ)<br /> )

cable2004

2. ;;快速查找三角形边长
   
3. ;by edata @ mjtd.com 2015-8-2
   
4. (defun c:tt(/ ss ss2 en pts ds1 ds2 ds3 ds4 p1 p2 p3 p4)
   
5.   (setq ss2(ssadd))
   
6.   (if(setq ss(ssget '((0 . "lwpolyline"))))
   
7.     (while(setq en(ssname ss 0))
   
8.       (setq pts(sk_getpt en))
   
9.       (setq pts(sk_removept pts 1e-6))
   
10.       (cond
    
11.         ((=(length pts) 3)     
    
12.          (if  (apply 'or (mapcar '(lambda(x y) (equal (distance x y) 349 2)) (cons (last pts) pts) pts))
    
13.            (setq ss2(ssadd en ss2))           
    
14.            )
    
15.          )
    
16.         ((=(length pts) 4)
    
17.          
    
18.                   
    
19.          (if(and
    
20.          (apply 'or (mapcar '(lambda(x y) (equal (distance x y) 160 2)) (cons (last pts) pts) pts))
    
21.          (equal (- (distance (car pts) (caddr pts))(distance (cadr pts) (cadddr pts))) 0 1e-6)
    
22.                )
    
23.            (setq ss2(ssadd en ss2))
    
24.            )
    
25.          )
    
26.         )
    
27.       (setq ss(ssdel en ss))
    
28.       )
    
29.     )
    
30.   (if (and ss2 (> (sslength ss2 ) 0))
    
31.     (progn      
    
32.       (sssetfirst nil ss2)
    
33.       (vl-cmdf "regen")
    
34.       )
    
35.     )
    
36.   (princ)
    
37.   )

;;快速查找三角形边长<br /> ;by edata @ mjtd.com 2015-8-2<br /> (defun c:tt(/ ss ss2 en pts ds1 ds2 ds3 ds4 p1 p2 p3 p4)<br />   (setq ss2(ssadd))<br />   (if(setq ss(ssget '((0 . "lwpolyline"))))<br />     (while(setq en(ssname ss 0))<br />       (setq pts(sk_getpt en))<br />       (setq pts(sk_removept pts 1e-6))<br />       (cond<br />         ((=(length pts) 3)     <br />          (if  (apply 'or (mapcar '(lambda(x y) (equal (distance x y) 349 2)) (cons (last pts) pts) pts))<br />            (setq ss2(ssadd en ss2))           <br />            )<br />          )<br />         ((=(length pts) 4)<br />          <br />                   <br />          (if(and<br />          (apply 'or (mapcar '(lambda(x y) (equal (distance x y) 160 2)) (cons (last pts) pts) pts))<br />          (equal (- (distance (car pts) (caddr pts))(distance (cadr pts) (cadddr pts))) 0 1e-6)<br />                )<br />            (setq ss2(ssadd en ss2))<br />            )<br />          )<br />         )<br />       (setq ss(ssdel en ss))<br />       )<br />     )<br />   (if (and ss2 (> (sslength ss2 ) 0))<br />     (progn      <br />       (sssetfirst nil ss2)<br />       (vl-cmdf "regen")<br />       )<br />     )<br />   (princ)<br />   )

llsheng_73

1. (defun c:tt(/ ss i a e s)
   
2.   (if(setq i 0
   
3.     s(ssadd)
   
4.     ss(ssget'((0 . "lwpolyline")(-4 . "<or")(90 . 3)(90 . 4)(-4 . "or>"))))
   
5.     (progn
   
6.       (repeat(sslength ss)
   
7. (setq e(ssname ss i)a(plinexy e)i(1+ i))
   
8. (if(or(apply'or(mapcar'(lambda(x)(equal 160 x 1e-10))(isrectangle a)))
   
9.        (apply'or(mapcar'(lambda(x)(equal 349 x 1e-10))(istriangle a))))
   
10.    (setq s(ssadd e s))))
    
11.       (sssetfirst'nil s)))
    
12.   )
    
13. (defun plinexy(e / a q m p p1);;;LWPolyline,POLYLINE顶点,去掉完全重合点
    
14.     (setq a(vlax-ename->vla-object e)
    
15.    q(vlax-safearray->list(vlax-variant-value(vla-get-Coordinates a)))
    
16.    m(if(=(vla-get-objectname a)"AcDb3dPolyline")'(setq p1(list (car q)(cadr q)(caddr q))q(cdddr q))
    
17.       '(setq p1(list (car q)(cadr q))q (cddr q))))
    
18.     (while q(eval m)
    
19.       (setq p(if(member p1 p)p(append p(list p1))))))
    
20. (defun isrectangle(pt);;如果为矩形返回长X宽
    
21. (IF(and(=(length pt)4)
    
22.      (equal(apply'-(mapcar'distance(cddr pt)pt))1e-10))
    
23.    (vl-sort(mapcar'distance(cdr pt)(cddr pt))'>))
    
24.   )
    
25. (defun istriangle(pt);;如果为三角形返回边长
    
26. (IF(and(=(length pt)3)
    
27. (/=(car(trans(mapcar'-(car pt)(cadr pt))0(mapcar'-(last pt)(cadr pt))))0))
    
28.    (mapcar'distance pt(cons(last pt)pt)))
    
29.   )

(defun c:tt(/ ss i a e s)<br />   (if(setq i 0<br />     s(ssadd)<br />     ss(ssget'((0 . "lwpolyline")(-4 . "<or")(90 . 3)(90 . 4)(-4 . "or>"))))<br />     (progn<br />       (repeat(sslength ss)<br /> (setq e(ssname ss i)a(plinexy e)i(1+ i))<br /> (if(or(apply'or(mapcar'(lambda(x)(equal 160 x 1e-10))(isrectangle a)))<br />        (apply'or(mapcar'(lambda(x)(equal 349 x 1e-10))(istriangle a))))<br />    (setq s(ssadd e s))))<br />       (sssetfirst'nil s)))<br />   )<br /> (defun plinexy(e / a q m p p1);;;LWPolyline,POLYLINE顶点,去掉完全重合点<br />     (setq a(vlax-ename->vla-object e)<br />    q(vlax-safearray->list(vlax-variant-value(vla-get-Coordinates a)))<br />    m(if(=(vla-get-objectname a)"AcDb3dPolyline")'(setq p1(list (car q)(cadr q)(caddr q))q(cdddr q))<br />       '(setq p1(list (car q)(cadr q))q (cddr q))))<br />     (while q(eval m)<br />       (setq p(if(member p1 p)p(append p(list p1))))))<br /> (defun isrectangle(pt);;如果为矩形返回长X宽<br /> (IF(and(=(length pt)4)<br />      (equal(apply'-(mapcar'distance(cddr pt)pt))1e-10))<br />    (vl-sort(mapcar'distance(cdr pt)(cddr pt))'>))<br />   )<br /> (defun istriangle(pt);;如果为三角形返回边长<br /> (IF(and(=(length pt)3)<br /> (/=(car(trans(mapcar'-(car pt)(cadr pt))0(mapcar'-(last pt)(cadr pt))))0))<br />    (mapcar'distance pt(cons(last pt)pt)))<br />   )