编辑误操作了,现补上代码,有些函数属本论坛收集的 - ;取得曲线顶点
- (defun vxs (e / i v lst)
- (setq i -1)
- (while (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
- (setq lst (cons v lst))
- )
- (reverse lst)
- )
- ;--------------------------
- ;判断多边形pts1(叫点集较好)是否在多边形pts2(首尾点相同的不自交点集)外,返回nil则全在内
- ;纯几何学判断
- ;(pst1<npts2 (vxs(car (entsel)))(vxs(car (entsel))))
- (defun pst1<npts2 (pts1 pts2 / pntonline ptisorout x pt)
- ;功能:判断点在直线上的位置
- ;参数:p1,p2:直线上的两点,例如直线上的起点和端点,p3:所要判断的点
- ;返回值:点的位置,等于0时(equal k 0.0 0.00000001)点在线上,
- ;大于0时点在线的左侧,小于0时点在线的右侧
- ;示例:(setq k(pntonline (getpoint) (getpoint) (getpoint)))
- (defun pntonline(p3 p1 p2 / p c B C P)
- (setq p p3)
- (apply '+ (mapcar '(lambda (b)
- (setq c(- (* (car p) (cadr b)) (* (cadr p) (car b))) p b )c )
- (list p1 p2 p3)))
- )
- ;判断点是否在多边形外,返回nil则不在界外
- ;(ptisorout (getpoint) (vxs(car (entsel))))
- (defun ptisorout (pt pts / jgls x lines)
- (while (cadr pts)
- (setq lines(cons(list (car pts)(cadr pts))lines))
- (setq pts(cdr pts))
- );多边形分解为单边
- (setq jgls(mapcar
- '(lambda (x)(pntonline pt (car x) (cadr x)))lines)
- )
- (vl-member-if '(lambda (x)(> x 0.00001))jgls)
- )
- ;--主函数就这句话------------
- (vl-remove-if '(lambda (x)(equal x nil))
- (mapcar '(lambda (pt)(ptisorout pt pts2))pts1)
- )
- )
- ;-----------------------------
- ;应用
- ;取得多边形内线实体, 不含多边形本身,实体不超过边界就算
- ;多边形范围必须在屏幕内
- ; 使用(ssget "wP" <pt-list> [filter-list])时,实体挂边就选不上,故写此函数
- ;(if(setq ss(ssgetpolyline (car(entsel))))(sslength ss))
- (defun ssgetpolyline (en / ss ss1 pts en1 nn)
- (setq pts(vxs en))
- (setq ss(ssget "CP" pts '((0 . "*polyline"))));这句可再进一步过滤,比如选地块内房屋
- (setq ss1 (ssadd) nn -1)
- (while (setq en1(ssname ss (setq nn(1+ nn))))
- (if(not(equal en1 en))
- (if(not(pst1<npts2 (vxs en1) pts))
- (setq ss1(ssadd en1 ss1));或进行其他函数操作
- )
- )
- )(if(> (sslength ss1)1)ss1)
- )
|