如何快速查某一边长的矩形及三角形
有若干多义线画的三角形、矩形（边长均未标注）如何快速查找边长为349的三角形，边长160的矩形，为防止偏差容差默认为2。 就这么多还是有非常多？如果就这么点，你还是直接标注后直接找出来用时更少。 图形非常多，通过查找标注尺寸的方法比较麻烦。 那就只好程序处理了。
获得 ss ， 遍历每个三角形和矩形对象， 计算边长，只要有 某个边长为 L+-2的，就计入一个 ssnew；
最后返回 ssnew
;;快速查找三角形边长
;by edata @ mjtd.com 2015-8-2
(defun c:tt(/ ss ss2 en pts ds1 ds2 ds3 ds4 p1 p2 p3 p4)
(setq ss2(ssadd))
(if(setq ss(ssget '((0 . "lwpolyline"))))
(while(setq en(ssname ss 0))
(setq pts(sk_getpt en) p1 nil p2 nil p3 nil p4 nil)
(setq pts(sk_removept pts 1e-6))
(cond
((=(length pts) 3)
(mapcar 'set '(p1 p2 p3) pts)
(setq ds1(distance p1 p2)
ds2(distance p2 p3)
ds3(distance p3 p1)
)
(if(or(equal 349 ds12)
(equal 349 ds22)
(equal 349 ds3 2)
)
(setq ss2(ssadd en ss2))
)
)
((=(length pts) 4)
(mapcar 'set '(p1 p2 p3 p4) pts)
(setq ds1(distance p1 p2)
ds2(distance p2 p3)
ds3(distance p3 p4)
ds4(distance p4 p1)
)
(if(or(equal 160 ds1 2)
(equal 160 ds2 2)
(equal 160 ds3 2)
(equal 160 ds4 2)
)
(setq ss2(ssadd en ss2))
)
)
)
(setq ss(ssdel en ss))
)
)
(if (and ss2 (> (sslength ss2 ) 0))
(progn
(sssetfirst nil ss2)
(vl-cmdf "regen")
)
)
(princ)
)
(defun sk_getpt(ent)
(mapcar 'cdr (vl-remove-if-not'(lambda(x)(= (car x) 10)) (entget ent)))
)
(defun sk_removept (ptLst fuzz / pt1)
(cond ((<= (length ptLst) 1) ptLst)
(t
(setq pt1 (car ptLst))
(cons pt1
(vl-remove-if
'(lambda (x) (and(equal (car pt1) (car x) fuzz)
(equal (cadr pt1) (cadr x) fuzz)
)
)
(sk_removept (cdr ptLst) fuzz)
)
)
)
)
) 用这个是否可以？未严格测试~~~;;功能] pline,lwpline各段长度 BY:qq181976640
;;示例(setq lens (vlens (car (entsel))))
(defun vlens (e / i len1 len2 lst)
(setq i 0 lst nil)
(while (and (setq len1 (vlax-curve-getDistAtParam e i))
(setq len2 (vlax-curve-getDistAtParam e (setq i (1+ i))))
)
(setq lst (cons (- len2 len1) lst))
)
(reverse lst)
)
;;查找含有某一长度的多段线
(defun c:tt(/ len ss i ss2 en lens)
(setq len (getreal "要查找的边长:"))
(if (and (setq ss(ssget '((0 . "*POLYLINE"))))
(> (sslength ss) 0)
(setq i 0)
(setq ss2(ssadd))
)
(while (setq en (ssname ss i))
(setq lens (vlens en))
(if (and
(or(=(length lens)3)(=(length lens)4))
(or (equal len (car lens) 0.1)
(equal len (cadr lens) 0.1)
(equal len (caddr lens) 0.1)
(equal len (cadddr lens) 0.1)
))
(setq ss2 (ssadd en ss2))
)
(setq i (1+ i))
)
)
(sssetfirst nil ss2)
(princ)
) 本帖最后由 cable2004 于 2015-8-4 02:02 编辑
;;快速查找三角形边长
;by edata @ mjtd.com 2015-8-2
(defun c:tt(/ ss ss2 en pts ds1 ds2 ds3 ds4 p1 p2 p3 p4)
(setq ss2(ssadd))
(if(setq ss(ssget '((0 . "lwpolyline"))))
(while(setq en(ssname ss 0))
(setq pts(sk_getpt en))
(setq pts(sk_removept pts 1e-6))
(cond
((=(length pts) 3)
(if(apply 'or (mapcar '(lambda(x y) (equal (distance x y) 349 2)) (cons (last pts) pts) pts))
(setq ss2(ssadd en ss2))
)
)
((=(length pts) 4)
(if(and
(apply 'or (mapcar '(lambda(x y) (equal (distance x y) 160 2)) (cons (last pts) pts) pts))
(equal (- (distance (car pts) (caddr pts))(distance (cadr pts) (cadddr pts))) 0 1e-6)
)
(setq ss2(ssadd en ss2))
)
)
)
(setq ss(ssdel en ss))
)
)
(if (and ss2 (> (sslength ss2 ) 0))
(progn
(sssetfirst nil ss2)
(vl-cmdf "regen")
)
)
(princ)
) 本帖最后由 llsheng_73 于 2015-8-4 13:24 编辑
(defun c:tt(/ ss i a e s)
(if(setq i 0
s(ssadd)
ss(ssget'((0 . "lwpolyline")(-4 . "<or")(90 . 3)(90 . 4)(-4 . "or>"))))
(progn
(repeat(sslength ss)
(setq e(ssname ss i)a(plinexy e)i(1+ i))
(if(or(apply'or(mapcar'(lambda(x)(equal 160 x 1e-10))(isrectangle a)))
(apply'or(mapcar'(lambda(x)(equal 349 x 1e-10))(istriangle a))))
(setq s(ssadd e s))))
(sssetfirst'nil s)))
)
(defun plinexy(e / a q m p p1);;;LWPolyline,POLYLINE顶点,去掉完全重合点
(setq a(vlax-ename->vla-object e)
q(vlax-safearray->list(vlax-variant-value(vla-get-Coordinates a)))
m(if(=(vla-get-objectname a)"AcDb3dPolyline")'(setq p1(list (car q)(cadr q)(caddr q))q(cdddr q))
'(setq p1(list (car q)(cadr q))q (cddr q))))
(while q(eval m)
(setq p(if(member p1 p)p(append p(list p1))))))
(defun isrectangle(pt);;如果为矩形返回长X宽
(IF(and(=(length pt)4)
(equal(apply'-(mapcar'distance(cddr pt)pt))1e-10))
(vl-sort(mapcar'distance(cdr pt)(cddr pt))'>))
)
(defun istriangle(pt);;如果为三角形返回边长
(IF(and(=(length pt)3)
(/=(car(trans(mapcar'-(car pt)(cadr pt))0(mapcar'-(last pt)(cadr pt))))0))
(mapcar'distance pt(cons(last pt)pt)))
)
页:
[1]