分享！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)))
)
)
)
页:
[1]