判断一个对象是否在封闭曲线内

自贡黄明儒

;;;作局部放大或者裁剪,都需要判断对象是否在封闭曲线内,今天正儿八经看了vla-intersectwith
;;;下的用法,发现两任何对象都可求交点,见笑了.
;;;判断一个对象是否在封闭曲线内(在曲线内返回T)
(defun C:In-or-out (/ OBJ1 OBJ2 P1 P2 UTIL)
  (vl-load-com)
  ;;1  以下对象是指除Pviewport和PolygonMesh外的任何对象
  ;;对象交点列表 or nil
  (defun All-intersectwith (obj1 obj2 / INT IPLIST)
    (setq int (vla-IntersectWith obj1 obj2 acExtendNoNe))
    (setq iplist (vl-catch-all-apply 'vlax-safearray->list (list (vlax-variant-value int))))
    (if (vl-catch-all-error-p iplist)
      nil
      (list->3pair iplist)
    )
  )                                                                                                                                                                                           ;defun
  ;;2  点在曲线内外,caoyin
  ;;  T------->在曲线内
  (defun LT:PT-INCURVE (PT CURVE / GetInters OBJ MINPT MAXPT E PS LST X Y)
    (defun GetInters (OBJ1 OBJ2 / PS LST)
      (setq PS (vla-intersectwith OBJ1 OBJ2 0)
            PS (vl-catch-all-apply 'vlax-safearray->list (list (vlax-variant-value PS)))
      )
      (if (and PS (not (vl-catch-all-error-p PS)))
        (while (setq LST (cons (list (car PS) (cadr PS)) LST)
                     PS  (cdddr PS)
               )
        )
      )
      LST
    )
    (if (equal (vlax-curve-getClosestPointTo CURVE PT) PT 1E-6)
      0
      (progn (setq OBJ (vlax-ename->vla-object CURVE))
             (vla-getboundingbox OBJ 'MINPT 'MAXPT)
             (mapcar '(lambda (X) (set X (vlax-safearray->list (eval X)))) '(MINPT MAXPT))
             (entmake
               (list '(0 . "LINE") (list 10 (car MINPT) (cadr PT)) (list 11 (car MAXPT) (cadr PT)) '(60 . 1))
             )
             (setq E    (entlast)
                   LST1 (GetInters OBJ (vlax-ename->vla-object E))
             )
             (entdel E)
             (if LST1
               (setq LST1 (vl-remove-if '(lambda (X / PP A)
                                           (setq PP (vlax-curve-getParamAtPoint CURVE X)
                                                 A  (angle '(0 0) (vlax-curve-getFirstDeriv CURVE PP))
                                           )
                                           (or (equal A 0 1E-6) (equal A PI 1E-6) (equal A (* PI 2) 1E-6) (equal (fix PP) PP 1E-6))
                                         )
                                        LST1
                          )
               )
             )
             (entmake
               (list '(0 . "LINE") (list 10 (car PT) (cadr MAXPT)) (list 11 (car PT) (cadr MINPT)) '(60 . 0))
             )
             (setq E    (entlast)
                   LST2 (GetInters OBJ (vlax-ename->vla-object E))
             )
             (entdel E)
             (if LST2
               (setq LST2 (vl-remove-if '(lambda (X / PP A)
                                           (setq X  (vlax-curve-getClosestPointTo CURVE X)
                                                 PP (vlax-curve-getParamAtPoint CURVE X)
                                                 A  (angle (vlax-curve-getFirstDeriv CURVE PP) '(0 0))
                                           )
                                           (or (equal A (/ PI 2) 1E-6) (equal A (* PI 1.5) 1E-6) (equal (fix PP) PP 1E-6))
                                         )
                                        LST2
                          )
               )
             )
             (and LST1
                  LST2
                  (progn (setq X (vl-sort-i (mapcar 'car (cons PT LST1)) '<)
                               Y (length (member 0 X))
                         )
                         (and (zerop (rem Y 2)) (= (rem (- (length X) Y) 2) 1))
                  )
                  (progn (setq X (vl-sort-i (mapcar 'cadr (cons PT LST2)) '<)
                               Y (length (member 0 X))
                         )
                         (and (zerop (rem Y 2)) (= (rem (- (length X) Y) 2) 1))
                  )
             )
      )
    )
  )

  
;;4  主程序
  (setq util (vla-get-utility (vla-get-activedocument (vlax-get-acad-object))))
  (vla-getentity util 'obj1 'ip "\n选择封闭曲线: ")
  (vla-getentity util 'obj2 'ip "\n选择对象: ")
  ;;如果两对象没有交点,要么在封闭曲线内,要么在封闭曲线外,故取对象中点判断是否在
  ;;封闭曲线内外即可
  (if (All-intersectwith obj1 obj2)
    nil
    (progn (vla-getboundingbox obj2 'p1 'p2)
           (setq p1 (vlax-safearray->list p1))
           (setq p2 (vlax-safearray->list p2))
           (LT:PT-INCURVE p1 (vlax-vla-object->ename obj1))
    )
  )
)

caoyin

我的论坛空间里面有一个更简单的思路，你可以参考下

caoyin

;;(defun c:TT (/ EN pt typ dst)
(if (and (setq en (car (entsel)))
         (or (vlax-curve-isClosed en)
             (progn(princ"\n曲线未封闭")nil)
         )
         (setq pt (getpoint"\n拾取点: "))
    )
(progn
  (setq typ (cdr (assoc 0 (entget en)))
        dst (lt:curve-getDistancePtTo En PT)
  )
  (if (wcmatch typ "*POLYLINE")
    (setq dst (- DST))
  )
  (cond ((> dst 0)(alert "点在曲线内"))
        ((= dst 0)(alert "点在曲线上"))
        ((< dst 0)(alert "点在曲线外"))
  )
)
)
)

byghbcx

可以通过过已知点与曲线最近的点所构成的直线与曲线的交点个数关于这个点的两边对称关系来判断。
(defun c:TT (/ EN pt pt1 en1 intpnt tmppnt ang k)
(if (and (setq en (car (entsel)))
         (or (vlax-curve-isClosed en)
             (progn(princ"\n曲线未封闭")nil)
         )
         (setq pt (getpoint"\n拾取点: "))
    )
(progn
  (setq pt1 (vlax-curve-getClosestPointTo en pt))
  (command "_.line" pt pt1 "")
  (setq en1 (entlast))
  (setq INTPNT (vla-intersectwith (vlax-ename->vla-object en1) (vlax-ename->vla-object en) acextendThisEntity)
        TMPPNT (vlax-variant-value INTPNT)
  )
  (cond ((safearray-value TMPPNT)
        (setq TMPLST (vlax-safearray->list TMPPNT))
        (repeat        (/ (length TMPLST) 3)
          (setq        PNTLST  (cons (list (car TMPLST) (cadr TMPLST) (caddr TMPLST)) PNTLST)
                TMPLST (cdddr TMPLST)
          )
        )
        (reverse PNTLST)
       )
       (t NIL)
  )
  (command "_.erase" en1 "")
  (setq ang (angle pt pt1) k 1)
  (mapcar '(lambda(x) (setq k (* k (if (equal (angle pt x) ang 0.0001) 1 -1)))) PNTLST)
  (cond ((= k -1)(alert "点在曲线内"))
        ((= k 1)(alert "点在曲线外"))
  )
)
)
)

李龙山

学习一下方法。

zhouwanweihf

求以上大师编写出放大样LISP，谢谢！

江湖远人

多谢楼主分享，收藏学习了

skg123

caoyin 发表于 2012-1-12 16:15
;;(defun c:TT (/ EN pt typ dst)
(if (and (setq en (car (entsel)))
         (or (vlax-curve-isClose ...

命令: tt

选择对象:
拾取点: ; 错误: no function definition: LT:CURVE-GETDISTANCEPTTO

命令:
命令: !dst nil

命令: !typ nil

命令: !pt nil
运行不正确？

yuanziyou

如果一个实体其中的一部分刚好在另一个实体的线上，会返回不在实体内