如果线是多边形感觉还是用面域的 并 差 交 来得快
高手们的代码有点看不懂，借助高手自已弄了一个，多指点谢谢。;; | ---------------------------------------------------------------------------
;; | jn-cpts
;; | ---------------------------------------------------------------------------
;; | Function :给定一个中心点和半径,等分数，返回圆上点列表
;; | Argument : (jn-cpts cpt r div-num)
;; | Returns: 返回圆上点列表
;; | Updated: 2011-12-4
;; | ---------------------------------------------------------------------------
(defun jn-cpts(cpt r div-num / ptl parti-deg jd ) ;求圆上点传入中心点和半径
(setq ptl NIL )
(setq parti-deg (/ (* 2.0 PI) div-num))
(setq jd parti-deg)
(while (< jd (* 2 PI))
(setq ptl (append (list (polar cpt jd r)) ptl))
(setq jd (+ parti-deg jd))
)
(setq ptl ptl)
)
(defun mkcircle(pt r) ;标记出错位置
(entmake (list '(0 . "circle")
(cons 10 pt)
(cons 40 r)
(cons 62 1)
(cons 8 "检查标记")))
)
;;求多段线顶点----不知谁编的-------
(defun GETPLVTX (E / ED )
(defun DXF (NO)
(cdr (assoc NO ED))
)
(defun GETLWPL (ED / PL)
(while (setq ED (cdr (member (setq PL10 (assoc 10 ED))
ED
) ))
(setq PL (cons (cdr PL10) PL))
)
(reverse PL)
)
(defun GETPL (ED / E PL P10)
(setq E (DXF -1))
(while (setq E (entnext E))
(if (setq P10 (cdr (assoc 10 (entget E))))
(setq PL (cons P10 PL))
))
(reverse PL)
)
(setq ED (entget E))
(setq PLTYPE (DXF 0))
(cond
((= "POLYLINE" PLTYPE)
(GETPL ED))
((= "LWPOLYLINE" PLTYPE)
(GETLWPL ED))))
;;---------------
(defun c:tt2( / en s ptl ss i pt blc jx s2 s3 d1);主程序，求裂隙
(SETVAR "CMDECHO" 0)
(if (= (setq jx (getreal "请输入检查间隙阀值<0.2m>： ")) NIL)
(setq jx 0.2))
(setq blc (/ (getvar "USERR1") 1000))
(if (= blc 0.0) (setq blc 0.5) );cass图形比例尺
(setq ss (ssget '((0 . "lwpolyline"))))
(repeat (setq i (sslength ss))
(setq s (cons (ssname ss (setq i (1- i))) s));把图元名做成表
)
(foreach en s
(setq ptl (GETPLVTX en))
(foreach ptptl
(setq s2 (ssget "cp" (jn-cpts pt (* 2 jx) 100) '((0 . "lwpolyline"))))
(repeat (setq i (sslength s2))
(setq s3 (cons (ssname s2 (setq i (1- i))) s3)));把图元名做成表
(setq s3 (vl-remove en s3))
(while s3
(princ s3)
(princ " -- ")
(setq d1 (distance (vlax-curve-getClosestPointTo (vlax-ename->vla-object (car s3)) pt) (list (car pt) (cadr pt))));只求平距
(if (and (< d1 jx) (> d1 0.0001))
(mkcircle pt (* 6 blc))
);endif
(setq s3 (cdr s3))
);endwhile
);endroeach
)
(SETVAR "CMDECHO" 1)
(princ "jn 2012-5-4")
)
看看 主要是为了学悍将
被院长吓到了。。偶只是想找那个命令~
来学习学习啊，都是高手啊
路过，留个记号
本帖最后由 soly2006 于 2012-6-9 19:42 编辑
soly2006 发表于 2012-5-4 18:11 static/image/common/back.gif
高手们的代码有点看不懂，借助高手自已弄了一个，多指点谢谢。
我的正常啊？哪里不对？应该比较理想了。
受g版程序启发，我自己也编了一个，在核对实宗虚宗面积的时候相当方便，感谢明经，感谢g版！
顶出院长的程序