[编程交流] 图案填充创建例程

(defun entmakex-hatch (L a n s)
;; By ElpanovEvgeniy
;; L - list point
;; A - angle hatch
;; N - name pattern
;; S - scale
;; returne - hatch ename
(entmakex
 (apply
  'append
  (list
   (list '(0 . "HATCH")
         '(100 . "AcDbEntity")
         '(410 . "Model")
         '(100 . "AcDbHatch")
         '(10 0.0 0.0 0.0)
         '(210 0.0 0.0 1.0)
         '(2 . "ANSI31")
         (if (= n "SOLID")
          '(70 . 1)
          '(70 . 0)
         ) ;_  if
         '(71 . 0)
         (cons 91 (length l))
   ) ;_  list
   (apply 'append
          (mapcar '(lambda (a)
                    (apply 'append
                           (list (list '(92 . 7) '(72 . 0) '(73 . 1) (cons 93 (length a)))
                                 (mapcar '(lambda (b) (cons 10 b)) a)
                                 '((97 . 0))
                           ) ;_  list
                    ) ;_  apply
                   ) ;_  lambda
                  l
          ) ;_  mapcar
   ) ;_  apply
   (list '(75 . 0)
         '(76 . 1)
         (cons 52 a)
         (cons 41 s)
         '(77 . 0)
         '(78 . 1)
         (cons 53 a)
         '(43 . 0.)
         '(44 . 0.)
         '(45 . 1.)
         '(46 . 1.)
         '(79 . 0)
         '(47 . 1.)
         '(98 . 2)
         '(10 0. 0. 0.0)
         '(10 0. 0. 0.0)
         '(451 . 0)
         '(460 . 0.0)
         '(461 . 0.0)
         '(452 . 1)
         '(462 . 1.0)
         '(453 . 2)
         '(463 . 0.0)
         '(463 . 1.0)
         '(470 . "LINEAR")
   ) ;_  list
  ) ;_  list
 ) ;_  apply
) ;_  entmakex
) ;_  defun

(entmakex-hatch '(((538.794 584.563) (895.629 584.563) (895.629 997.377) (538.794 997.377))
                 ((386.809 345.13) (670.955 345.13) (670.955 855.369) (386.809 855.369))
                )
               (/ pi 2)
               "ANSI31"
               2.
) ;_  entmakex-hatch
(entmakex-hatch
(list
 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car (entsel)))))
) ;_  list
(/ pi 2)
"ANSI31"
2.
)

(defun entmakex-solidhatch ( L )
 ;; L - list of list point. like ((pt11 pt12 pt13)(pt21 pt22 pt23))
 ;; Use
;;;(entmakex-solidhatch
;;;    (list
;;;      (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car (entsel "\nSelect Polyline:")))))
;;;      );_  list
;;;    )
 (entmakex
 (apply
  'append
  (list
   (list '(0 . "HATCH")
         '(100 . "AcDbEntity")
         '(410 . "Model")
         '(100 . "AcDbHatch")
         '(10 0.0 0.0 0.0)
         '(210 0.0 0.0 1.0)
         (cons 2 "SOLID")
         '(70 . 1)
         '(71 . 0)
         (cons 91 (length L))
   ) ;_  list
   (apply 'append
          (mapcar '(lambda (a)
                    (apply 'append
                           (list (list '(92 . 7) '(72 . 0) '(73 . 1) (cons 93 (length a)))
                                 (mapcar '(lambda (b) (cons 10 b)) a)
                                 '((97 . 0))
                           ) ;_  list
                    ) ;_  apply
                   ) ;_  lambda
                  L
          ) ;_  mapcar
   ) ;_  apply
   (list '(75 . 0)
         '(76 . 1)
         '(47 . 1.)
         '(98 . 2)
         '(10 0. 0. 0.0)
         '(10 0. 0. 0.0)
         '(450 . 0)
         '(451 . 0)
         '(460 . 0.0)
         '(461 . 0.0)
         '(452 . 0)
         '(462 . 0.0)
         '(453 . 2)
         '(463 . 0.0)
         '(63 . 256)
         '(463 . 1.0)
         '(63 . 256)
         '(470 . "LINEAR")
   ) ;_  list
  ) ;_  list
 ) ;_  apply
)
 )