检查折线间有无裂缝，请各高手提供个算法[已解决]

gufeng

如果线是多边形感觉还是用面域的 并 差 交 来得快

soly2006

高手们的代码有点看不懂，借助高手自已弄了一个，多指点谢谢。

2. ;; | ---------------------------------------------------------------------------
   
3. ;; | jn-cpts
   
4. ;; | ---------------------------------------------------------------------------
   
5. ;; | Function :  给定一个中心点和半径,等分数，返回圆上点列表
   
6. ;; | Argument : (jn-cpts cpt r div-num)
   
7. ;; | Returns  : 返回圆上点列表
   
8. ;; | Updated  : 2011-12-4
   
9. ;; | ---------------------------------------------------------------------------
   
10. (defun jn-cpts(cpt r div-num / ptl parti-deg jd ) ;求圆上点传入中心点和半径
    
11. (setq ptl NIL )
    
12. (setq parti-deg (/ (* 2.0 PI) div-num))
    
13. (setq jd parti-deg)
    
14. (while (< jd (* 2 PI))
    
15. (setq ptl (append (list (polar cpt jd r)) ptl))
    
16. (setq jd (+ parti-deg jd))
    
17. )
    
18. (setq ptl ptl)
    
19. )
    
20. 
    
21. (defun mkcircle  (pt r) ;标记出错位置
    
22.     (entmake (list '(0 . "circle")
    
23.                    (cons 10 pt)
    
24.                    (cons 40 r)
    
25.                    (cons 62 1)
    
26.                    (cons 8 "检查标记")))
    
27. )
    
28. 
    
29. ;;求多段线顶点----不知谁编的-------
    
30. (defun GETPLVTX (E / ED )
    
31. (defun DXF (NO)
    
32. (cdr (assoc NO ED))
    
33. )
    
34. (defun GETLWPL (ED / PL)
    
35. (while (setq ED (cdr (member (setq PL10 (assoc 10 ED))
    
36.      ED
    
37.     )   )  )
    
38. (setq PL (cons (cdr PL10) PL))
    
39. )
    
40. (reverse PL)
    
41. )
    
42. (defun GETPL (ED / E PL P10)
    
43. (setq E (DXF -1))
    
44. (while (setq E (entnext E))
    
45. (if (setq P10 (cdr (assoc 10 (entget E))))
    
46.   (setq PL (cons P10 PL))
    
47. ))
    
48. (reverse PL)
    
49. )
    
50. (setq ED (entget E))
    
51. (setq PLTYPE (DXF 0))
    
52. (cond
    
53. ((= "POLYLINE" PLTYPE)
    
54. (GETPL ED))
    
55. ((= "LWPOLYLINE" PLTYPE)
    
56. (GETLWPL ED))))
    
57. ;;---------------
    
58. 
    
59. (defun c:tt2( / en s ptl ss i pt blc jx s2 s3 d1);主程序，求裂隙
    
60. (SETVAR "CMDECHO" 0)
    
61. (if (= (setq jx (getreal "请输入检查间隙阀值<0.2m>： ")) NIL)
    
62.   (setq jx 0.2))
    
63. (setq blc (/ (getvar "USERR1") 1000))
    
64. (if (= blc 0.0) (setq blc 0.5) );cass图形比例尺
    
65. (setq ss (ssget '((0 . "lwpolyline"))))
    
66. 
    
67. (repeat (setq i (sslength ss))
    
68. (setq s (cons (ssname ss (setq i (1- i))) s))  ;把图元名做成表
    
69. )
    
70. (foreach en s
    
71. (setq ptl (GETPLVTX en))
    
72. (foreach pt  ptl
    
73.   (setq s2 (ssget "cp" (jn-cpts pt (* 2 jx) 100) '((0 . "lwpolyline"))))
    
74.     (repeat (setq i (sslength s2))
    
75.      (setq s3 (cons (ssname s2 (setq i (1- i))) s3)))  ;把图元名做成表
    
76.   (setq s3 (vl-remove en s3))
    
77.   (while s3
    
78.   (princ s3)
    
79.   (princ " -- ")
    
80.   (setq d1 (distance (vlax-curve-getClosestPointTo (vlax-ename->vla-object (car s3)) pt) (list (car pt) (cadr pt))));只求平距
    
81.   (if (and (< d1 jx) (> d1 0.0001))
    
82.    (mkcircle pt (* 6 blc))
    
83.   );endif
    
84.   (setq s3 (cdr s3))
    
85.   );endwhile
    
86.   );endroeach
    
87. )
    
88. (SETVAR "CMDECHO" 1)
    
89. (princ "jn 2012-5-4")
    
90. )
    
91. 
    
92. 
    

;; | ---------------------------------------------------------------------------<br /> ;; | jn-cpts<br /> ;; | ---------------------------------------------------------------------------<br /> ;; | Function :  给定一个中心点和半径,等分数，返回圆上点列表<br /> ;; | Argument : (jn-cpts cpt r div-num)<br /> ;; | Returns  : 返回圆上点列表<br /> ;; | Updated  : 2011-12-4<br /> ;; | ---------------------------------------------------------------------------<br /> (defun jn-cpts(cpt r div-num / ptl parti-deg jd ) ;求圆上点传入中心点和半径<br /> (setq ptl NIL )<br /> (setq parti-deg (/ (* 2.0 PI) div-num))<br /> (setq jd parti-deg)<br /> (while (< jd (* 2 PI))<br /> (setq ptl (append (list (polar cpt jd r)) ptl))<br /> (setq jd (+ parti-deg jd))<br /> )<br /> (setq ptl ptl)<br /> )<br /> <br /> (defun mkcircle  (pt r) ;标记出错位置<br />     (entmake (list '(0 . "circle")<br />                    (cons 10 pt)<br />                    (cons 40 r)<br />                    (cons 62 1)<br />                    (cons 8 "检查标记")))<br /> )<br /> <br /> ;;求多段线顶点----不知谁编的-------<br /> (defun GETPLVTX (E / ED )<br /> (defun DXF (NO)<br /> (cdr (assoc NO ED))<br /> )<br /> (defun GETLWPL (ED / PL)<br /> (while (setq ED (cdr (member (setq PL10 (assoc 10 ED))<br />      ED<br />     )   )  )<br /> (setq PL (cons (cdr PL10) PL))<br /> )<br /> (reverse PL)<br /> )<br /> (defun GETPL (ED / E PL P10)<br /> (setq E (DXF -1))<br /> (while (setq E (entnext E))<br /> (if (setq P10 (cdr (assoc 10 (entget E))))<br />   (setq PL (cons P10 PL))<br /> ))<br /> (reverse PL)<br /> )<br /> (setq ED (entget E))<br /> (setq PLTYPE (DXF 0))<br /> (cond<br /> ((= "POLYLINE" PLTYPE)<br /> (GETPL ED))<br /> ((= "LWPOLYLINE" PLTYPE)<br /> (GETLWPL ED))))<br /> ;;---------------<br /> <br /> (defun c:tt2( / en s ptl ss i pt blc jx s2 s3 d1);主程序，求裂隙<br /> (SETVAR "CMDECHO" 0)<br /> (if (= (setq jx (getreal "请输入检查间隙阀值<0.2m>： ")) NIL) <br />   (setq jx 0.2))<br /> (setq blc (/ (getvar "USERR1") 1000))<br /> (if (= blc 0.0) (setq blc 0.5) );cass图形比例尺<br /> (setq ss (ssget '((0 . "lwpolyline"))))<br /> <br /> (repeat (setq i (sslength ss))<br /> (setq s (cons (ssname ss (setq i (1- i))) s))  ;把图元名做成表<br /> )<br /> (foreach en s<br /> (setq ptl (GETPLVTX en))<br /> (foreach pt  ptl<br />   (setq s2 (ssget "cp" (jn-cpts pt (* 2 jx) 100) '((0 . "lwpolyline"))))<br />     (repeat (setq i (sslength s2))<br />      (setq s3 (cons (ssname s2 (setq i (1- i))) s3)))  ;把图元名做成表<br />   (setq s3 (vl-remove en s3))<br />   (while s3<br />   (princ s3)<br />   (princ " -- ")<br />   (setq d1 (distance (vlax-curve-getClosestPointTo (vlax-ename->vla-object (car s3)) pt) (list (car pt) (cadr pt))));只求平距<br />   (if (and (< d1 jx) (> d1 0.0001))<br />    (mkcircle pt (* 6 blc))<br />   );endif<br />   (setq s3 (cdr s3))<br />   );endwhile<br />   );endroeach<br /> )<br /> (SETVAR "CMDECHO" 1)<br /> (princ "jn 2012-5-4")<br /> )<br /> <br /> <br />

longer1000

看看 主要是为了学悍将

redcat

flytoday

被院长吓到了。。偶只是想找那个命令~

都不好意思了

来学习学习啊，都是高手啊

lpl

路过，留个记号

soly2006

soly2006 发表于 2012-5-4 18:11
高手们的代码有点看不懂，借助高手自已弄了一个，多指点谢谢。

我的正常啊？哪里不对？应该比较理想了。

changyiran

受g版程序启发，我自己也编了一个，在核对实宗虚宗面积的时候相当方便，感谢明经，感谢g版！

xujinhua

顶出院长的程序