本帖最后由 changyiran 于 2012-8-21 16:49 编辑

[code="lisp]

(defun fjdb(en / x);返回轻量多段线的点表

(vl-remove-if'not

(mapcar'(lambda(x)(if(=(car x)10)(cdr x)))(entget en));mapcar返回的是一个表，lambda构造一个匿名函数

)

)[/code]

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

(defun c:jcfx(/ BJXDB BJYBJ CXJL EN FXGS J M PDZ QSXZBB QYTYB SS YBJZB TYCCB ZXCXJL);检查缝隙(裂缝、相交缝)

(command"undo"m)

(setq cxjl(getreal"\n请输入最大查询距离(0.3):"))

(setq zxcxjl(getreal"\n请输入最小查询距离(0.0001):"))

(if (not cxjl)(setq cxjl 0.3))

(if (not zxcxjl)(setq zxcxjl 0.0001))

(setq bjybj(getreal"\n请输入标记圆半径(2):")fxgs 0 ybjzb'())

(if (not bjybj)(setq bjybj 2))

(setq en(car(entsel"\n请选择外围边界线(如果没有外围线直接回车):")))

(if (not en);没有外围线

(progn

(princ"\n请选择权属线:")

(setq ss(ssget'((0 . "lwpolyline")(8 . "jzd"))))

(setq tyccb'()j -1)

)

(progn

(setq bjxdb(fjdb en)fxgs 0);获取边界线点表

(setq ss(ssget"cp"bjxdb'((0 . "lwpolyline")(8 . "jzd"))));建立边界线内部权属线选择集

(setq tyccb(list en)j -1);建立图元储存表

)

)

(repeat(sslength ss)

(setq tyccb(cons (ssname ss (setq j(1+ j)))tyccb))

)

(foreach en tyccb

(setq qytyb(vl-remove en tyccb));建立其余图元储存表

(setq qsxzbb(fjdb en));获取权属线坐标表

(foreach pt qsxzbb

(if(not(vl-position pt ybjzb));该点位没有参加过比较

(progn

(setq ybjzb(cons pt ybjzb))

(setq pdz(vl-some'(lambda(x)

(setq jlz(distance pt(vlax-curve-getClosestPointTo x pt)))

(and(> jlz zxcxjl)(< jlz cxjl)))

qytyb

)

)

)

)

(if pdz

(progn

(entmake(list'(0 . "circle")(list 10(car pt)(cadr pt))'(8 . "缝隙标记")(cons 40 bjybj)'(62 . 2)))

(setq fxgs(1+ fxgs))

)

)

)

)

(if(= 0 fxgs)

(alert"没有发现缝隙处")

(alert(strcat"共发现"(itoa fxgs)"处缝隙"))

)

(princ)

)[/code]