[编程交流] 基于环境创建图案填充

(defun c:foo (/ _addhatch _bnd a ao b d doc e ll mp o s sp ur vc vs)
 (defun _addhatch (e c sp l / h)
   (if        (setq h (vla-addhatch sp achatchpatterntypepredefined "SOLID" :vlax-false))
     (progn (vlax-invoke h 'appendouterloop (list e))
     (vla-put-color h c)
     (vla-evaluate h)
     (vla-update h)
     (entmod (append (entget (vlax-vla-object->ename h)) (list (cons 8 l))))
     h
     )
   )
 )
 (defun _bnd (p l / e)
   (setq e (entlast))
   (command "_.-boundary" p "")
   (cond ((not (equal e (entlast)))
   (entmod (append (entget (setq e (entlast))) (list (cons 8 l))))
   (vlax-ename->vla-object e)
  )
   )
 )
 (if (setq s (ssget '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1))))
   (progn
     (setq doc (vla-get-activedocument (setq ao (vlax-get-acad-object))))
     (vla-startundomark doc)
     (setq sp (vlax-get doc
                 (cond ((= 1 (getvar 'cvport)) 'paperspace)
                       ('modelspace)
                 )
       )
     )
     (vla-put-lock (vlax-ename->vla-object (tblobjname "layer" (getvar 'clayer))) :vlax-false)
     (setq vc (getvar 'viewctr))
     (setq vs (getvar 'viewsize))
     (foreach b (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
(setq o (vlax-ename->vla-object b))
(if
  (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'll 'ur))))
       (mapcar 'set '(ll ur) (mapcar 'vlax-safearray->list (list ll ur)))
       (setq e (entmakex (list '(0 . "line") '(8 . "tempfoo") (cons 10 ll) (cons 11 ur))))
  )
   (progn (setq mp (mapcar '(lambda (a b) (/ (+ a b) 2.)) ll ur))
          (vlax-invoke ao 'zoomcenter mp (setq d (distance ll ur)))
          (and (setq a (_bnd (list (+ (car mp) (* d 0.1)) (cadr mp)) "BoundaryA"))
               (_addhatch a 1 sp "HatchA")
          )
          (and (setq b (_bnd (list (- (car mp) (* d 0.1)) (cadr mp)) "BoundaryB"))
               (_addhatch b 3 sp "HatchB")
          )
   )
)
(and e (entdel e))
     )
     (vla-endundomark doc)
     (vlax-invoke ao 'zoomcenter vc vs)
   )
 )
 (princ)
)