[编程交流] 在不同多边形中创建图案填充

(defun c:test ( / PointInside ss pt i e l hObj ) (vl-load-com)
 (defun PointInside ( pt ptlst )
   (acet-geom-point-inside pt ptlst
     ( (lambda ( m / d ) (foreach x ptlst (if (< m (setq d (distance pt x))) (setq m d))) m)
       0.0
     )
   )
 )
 (if
   (and
     (setq ss (ssget "_X" '((0 . "LWPOLYLINE") (70 . 1))))
     (setq pt (getpoint "\nPick Internal Point: "))
   )
   (progn
     (setq i -1 pt (trans pt 1 0))
     
     (while (setq e (ssname ss (setq i (1+ i))))
       (if
         (PointInside pt
           (mapcar
             (function
               (lambda ( p ) (trans (cdr p) e 0))
             )
             (vl-remove-if-not (function (lambda ( p ) (= 10 (car p)))) (entget e))
           )
         )
         (setq l (cons e l))
       )
     )
     (if
       (setq e
         (car
           (vl-sort l
             (function
               (lambda ( a b )
                 (<
                   (distance pt (vlax-curve-getClosestPointto a pt))
                   (distance pt (vlax-curve-getClosestPointto b pt))
                 )
               )
             )
           )
         )
       )
       (progn
         (setq hObj
           (vla-AddHatch
             (vlax-get-property
               (vla-get-ActiveDocument (vlax-get-acad-object))
               (if (= 1 (getvar 'CVPORT))
                 'Paperspace
                 'Modelspace
               )
             )
             acHatchPatternTypePredefined "ANSI31" :vlax-true AcHatchObject
           )
         )
         (vlax-invoke hObj 'AppendOuterLoop (list (vlax-ename->vla-object e)))
         (vla-Evaluate hObj)
       )
     )
   )
 )
 (princ)  
)