请大神帮忙分析这一点处怎么可能是裂缝(检查多段线之间的缝隙)

changyiran

2. (defun fjdb(en / x);返回轻量多段线的点表
   
3.   (vl-remove-if'not
   
4.         (mapcar'(lambda(x)(if(=(car x)10)(cdr x)))(entget en));mapcar返回的是一个表，lambda构造一个匿名函数
   
5.   )        
   
6. )

(defun fjdb(en / x);返回轻量多段线的点表<br />   (vl-remove-if'not<br />         (mapcar'(lambda(x)(if(=(car x)10)(cdr x)))(entget en));mapcar返回的是一个表，lambda构造一个匿名函数<br />   )        <br /> )

这是我写的查询缝隙的程序，根据本程序一共查出了19处缝隙，白色的圆圈标出的确实是裂缝，但是蓝色的圆圈怎么可能是裂缝，两个多段线在这一点处明明是重合的啊，我的程序难道有什么问题吗？请大神们帮忙分析下这个十分困扰我的问题。

2. (defun c:jcfx(/ BJXDB BJYBJ CXJL EN FXGS J M PDZ QSXZBB QYTYB SS YBJZB TYCCB ZXCXJL);检查缝隙（裂缝、相交缝）
   
3.   (command"undo"m)
   
4.   (setq cxjl(getreal"\n请输入最大查询距离(0.3):"))
   
5.   (setq zxcxjl(getreal"\n请输入最小查询距离(0.0001):"))
   
6.   (if (not cxjl)(setq cxjl 0.3))
   
7.   (if (not zxcxjl)(setq zxcxjl 0.0001))
   
8.   (setq bjybj(getreal"\n请输入标记圆半径(2):")fxgs 0 ybjzb'())
   
9.   (if (not bjybj)(setq bjybj 2))
   
10.   (setq en(car(entsel"\n请选择外围边界线(如果没有外围线直接回车):")))
    
11.   (if (not en);没有外围线
    
12.       (progn
    
13.   (princ"\n请选择权属线:")
    
14.         (setq ss(ssget'((0 . "lwpolyline")(8 . "jzd"))))
    
15.   (setq tyccb'()j -1)
    
16.       )
    
17.       (progn
    
18.         (setq bjxdb(fjdb en)fxgs 0);获取边界线点表
    
19.         (setq ss(ssget"cp"bjxdb'((0 . "lwpolyline")(8 . "jzd"))));建立边界线内部权属线选择集
    
20.   (setq tyccb(list en)j -1);建立图元储存表
    
21.       )
    
22.   )
    
23.   (repeat(sslength ss)
    
24.          (setq tyccb(cons (ssname ss (setq j(1+ j)))tyccb))
    
25.   )
    
26.   (foreach en tyccb
    
27.     (setq qytyb(vl-remove en tyccb));建立其余图元储存表
    
28.     (setq qsxzbb(fjdb en));获取权属线坐标表
    
29.     (foreach pt qsxzbb
    
30.        (if(not(vl-position pt ybjzb));该点位没有参加过比较
    
31.     (progn
    
32.          (setq ybjzb(cons pt ybjzb))
    
33.          (setq pdz(vl-some'(lambda(x)
    
34.                  (setq jlz(distance pt(vlax-curve-getClosestPointTo x pt)))
    
35.            (and(> jlz zxcxjl)(< jlz cxjl)))
    
36.          qytyb
    
37.             )
    
38.          )
    
39.     )
    
40.        )
    
41.       (if pdz
    
42.    (progn
    
43.      (entmake(list'(0 . "circle")(list 10(car pt)(cadr pt))'(8 . "缝隙标记")(cons 40 bjybj)'(62 . 2)))
    
44.      (setq fxgs(1+ fxgs))
    
45.    )
    
46.       )
    
47.     )
    
48.   )
    
49.   (if(= 0 fxgs)
    
50.      (alert"没有发现缝隙处")
    
51.      (alert(strcat"共发现"(itoa fxgs)"处缝隙"))
    
52.   )
    
53.   (princ)
    
54. )

(defun c:jcfx(/ BJXDB BJYBJ CXJL EN FXGS J M PDZ QSXZBB QYTYB SS YBJZB TYCCB ZXCXJL);检查缝隙（裂缝、相交缝）<br />   (command"undo"m)<br />   (setq cxjl(getreal"\n请输入最大查询距离(0.3):"))<br />   (setq zxcxjl(getreal"\n请输入最小查询距离(0.0001):"))<br />   (if (not cxjl)(setq cxjl 0.3))<br />   (if (not zxcxjl)(setq zxcxjl 0.0001))<br />   (setq bjybj(getreal"\n请输入标记圆半径(2):")fxgs 0 ybjzb'())<br />   (if (not bjybj)(setq bjybj 2))<br />   (setq en(car(entsel"\n请选择外围边界线(如果没有外围线直接回车):")))<br />   (if (not en);没有外围线<br />       (progn<br />   (princ"\n请选择权属线:")<br />         (setq ss(ssget'((0 . "lwpolyline")(8 . "jzd"))))<br />   (setq tyccb'()j -1)<br />       )<br />       (progn<br />         (setq bjxdb(fjdb en)fxgs 0);获取边界线点表<br />         (setq ss(ssget"cp"bjxdb'((0 . "lwpolyline")(8 . "jzd"))));建立边界线内部权属线选择集<br />   (setq tyccb(list en)j -1);建立图元储存表<br />       )<br />   )<br />   (repeat(sslength ss)<br />          (setq tyccb(cons (ssname ss (setq j(1+ j)))tyccb))<br />   )<br />   (foreach en tyccb<br />     (setq qytyb(vl-remove en tyccb));建立其余图元储存表<br />     (setq qsxzbb(fjdb en));获取权属线坐标表<br />     (foreach pt qsxzbb<br />        (if(not(vl-position pt ybjzb));该点位没有参加过比较<br />     (progn<br />          (setq ybjzb(cons pt ybjzb))<br />          (setq pdz(vl-some'(lambda(x)<br />                  (setq jlz(distance pt(vlax-curve-getClosestPointTo x pt)))<br />            (and(> jlz zxcxjl)(< jlz cxjl)))<br />          qytyb<br />             )<br />          )<br />     )<br />        )<br />       (if pdz<br />    (progn<br />      (entmake(list'(0 . "circle")(list 10(car pt)(cadr pt))'(8 . "缝隙标记")(cons 40 bjybj)'(62 . 2)))<br />      (setq fxgs(1+ fxgs))<br />    )<br />       )<br />     )<br />   )<br />   (if(= 0 fxgs)<br />      (alert"没有发现缝隙处")<br />      (alert(strcat"共发现"(itoa fxgs)"处缝隙"))<br />   )<br />   (princ)<br /> )

changyiran

我自己调试了下，正式怀疑cad有bug，我分段调试程序时有一部分圆的圆心在黄线上，当程序运行完毕时那些本来圆心在黄线上的圆居然也跑到了红线上，还有黄线上蓝色圈处所在点离红线的距离是0，而红线上蓝色圈处所在点离黄线的距离居然是0.000169285，更崩溃的时程序运行时是0.000169285，而运行结束后再算这个距离居然又变成了0，cad和lisp伤不起啊！

changyiran

如此一来检查多段线缝隙的程序该怎么写呢，哎，真是困扰人啊

changyiran

高手们为什么都不出现呢？

srv2

no function definition: FJDB
不知是怎麽回事?

changyiran

我把我自己的研究结果继续写出来，希望有高手能给予合理的解答。设黄色多段线位于蓝色圈圆心处的点为pt1，而红色红色多段线相应位置的点为pt2，黄色线上离pt2最近的点为zj1，红色线上离pt1最近的点为zj2，用equal实验pt1和pt2返回T，zj1和zj2同样返回T，而pt1和zj2以及pt2和zj1居然返回nil，这么奇怪的事情，且不说其他的，根据equal就算等价代换这四个值也应该分别相等啊，真是搞不懂。

changyiran

srv2 发表于 2012-8-21 16:31  no function definition: FJDB  不知是怎麽回事?

哦，这是我自己写的一个返回多段线顶点坐标的一个函数，忘了传了。现在传上去

changyiran

万能的明经啊，帮帮俺吧！

changyiran

调试到现在终于找到原因了，原来是pdz放的位置不对！可以放松了！

changyiran

不过还是有一点不太明白，本该标注在黄色多段线上的圆为什么都跑到了红色多段线上。