明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 700|回复: 7

[提问] 如何快速查某一边长的矩形及三角形

[复制链接]
发表于 2015-8-1 18:49 | 显示全部楼层 |阅读模式
有若干多义线画的三角形、矩形(边长均未标注)如何快速查找边长为349的三角形,边长160的矩形,为防止偏差容差默认为2。

本帖子中包含更多资源

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

x
发表于 2015-8-1 19:33 | 显示全部楼层
就这么多还是有非常多?
如果就这么点,你还是直接标注后直接找出来用时更少。
 楼主| 发表于 2015-8-1 20:06 | 显示全部楼层
图形非常多,通过查找标注尺寸的方法比较麻烦。
发表于 2015-8-2 10:09 | 显示全部楼层
那就只好程序处理了。
获得 ss , 遍历每个三角形和矩形对象, 计算边长,只要有 某个边长为 L+-2的,就计入一个 ssnew;
最后返回 ssnew
发表于 2015-8-2 11:55 | 显示全部楼层
  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.   )

点评

e大,好像应该加一个矩形判断!  发表于 2015-8-4 01:42
发表于 2015-8-3 23:59 | 显示全部楼层
用这个是否可以?未严格测试~~~
  1. ;;功能] pline,lwpline各段长度 BY:qq181976640
  2. ;;示例(setq lens (vlens (car (entsel))))
  3. (defun vlens (e / i len1 len2 lst)
  4.   (setq i 0 lst nil)
  5.   (while (and (setq len1 (vlax-curve-getDistAtParam e i))
  6.                     (setq len2 (vlax-curve-getDistAtParam e (setq i (1+ i))))
  7.                  )
  8.       (setq lst (cons (- len2 len1) lst))
  9.     )
  10.   (reverse lst)
  11. )
  12. ;;查找含有某一长度的多段线
  13. (defun c:tt(/ len ss i ss2 en lens)
  14.         (setq len (getreal "要查找的边长:"))
  15.   (if (and (setq ss(ssget '((0 . "*POLYLINE"))))
  16.                  (> (sslength ss) 0)
  17.                  (setq i 0)
  18.                  (setq ss2(ssadd))
  19.                 )
  20.     (while (setq en (ssname ss i))
  21.       (setq lens (vlens en))
  22.       (if (and
  23.               (or(=(length lens)3)(=(length lens)4))
  24.               (or (equal len (car lens) 0.1)
  25.                      (equal len (cadr lens) 0.1)
  26.                      (equal len (caddr lens) 0.1)
  27.                      (equal len (cadddr lens) 0.1)
  28.            ))
  29.        (setq ss2 (ssadd en ss2))
  30.        )
  31.       (setq i (1+ i))
  32.     )
  33.    )
  34.    (sssetfirst nil ss2)
  35.    (princ)
  36. )
发表于 2015-8-4 01:46 | 显示全部楼层
本帖最后由 cable2004 于 2015-8-4 02:02 编辑
  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))
  8.       (setq pts(sk_removept pts 1e-6))
  9.       (cond
  10.         ((=(length pts) 3)     
  11.          (if  (apply 'or (mapcar '(lambda(x y) (equal (distance x y) 349 2)) (cons (last pts) pts) pts))
  12.            (setq ss2(ssadd en ss2))           
  13.            )
  14.          )
  15.         ((=(length pts) 4)
  16.          
  17.                   
  18.          (if(and
  19.          (apply 'or (mapcar '(lambda(x y) (equal (distance x y) 160 2)) (cons (last pts) pts) pts))
  20.          (equal (- (distance (car pts) (caddr pts))(distance (cadr pts) (cadddr pts))) 0 1e-6)
  21.                )
  22.            (setq ss2(ssadd en ss2))
  23.            )
  24.          )
  25.         )
  26.       (setq ss(ssdel en ss))
  27.       )
  28.     )
  29.   (if (and ss2 (> (sslength ss2 ) 0))
  30.     (progn      
  31.       (sssetfirst nil ss2)
  32.       (vl-cmdf "regen")
  33.       )
  34.     )
  35.   (princ)
  36.   )
发表于 2015-8-4 13:17 | 显示全部楼层
本帖最后由 llsheng_73 于 2015-8-4 13:24 编辑

  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.   )
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-29 05:49 , Processed in 0.171087 second(s), 30 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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