[编程交流] 分享！match_图案填充

(defun c:match_hatch (/ s0 hp ha hs ss i s1)
 (if (and
(setq s0 (car (entsel "\nSelect source hatch: ")))
(TKS-etype s0 "hatch")
     )
   (progn
     (redraw s0 3)
     (setq hp (TKS-get-dxf 2 s0)
    ha (TKS-r2d (TKS-get-dxf 52 s0))
    hs (TKS-get-dxf 41 s0)
     )
     (setvar "CLAYER" (TKS-get-dxf 8 s0))
     (princ "\nSelect destination object: ")
     (if (setq ss (ssget '((0 . "*polyline,circle,ellipse")))
        i -1
  )
(progn
  (while (setq s1 (ssname ss (setq i (1+ i))))
    (command "hatch" hp hs ha s1 "")
  )
)
     )
     (redraw s0 4)
   )
 )
)
(defun TKS-R2D (rad)
 (* (/ rad pi) 180.0)
)
(defun TKS-Etype (ename etype)
 (wcmatch (TKS-get-dxf 0 ename) (strcase etype))
)
(defun TKS-get-DXF (code ename / ent lst a)
 (if (= (type code) 'LIST)
   (progn
     (setq ent (entget ename)
    lst '()
     )
     (foreach a code
(setq lst (cons (list a (cdr (assoc a ent))) lst))
     )
     (reverse lst)
   )
   (if (= code -3)
     (cdr (assoc code (entget ename '("*"))))
     (cdr (assoc code (entget ename)))
   )
 )
)