CadFrank 发表于 2022-7-5 18:26:36

图案填充创建例程

嗨,又是我。
 
我想为马做一些宏。
 
我知道我可以使用命令功能。
 
但我的HATCH有着坚实的背景。
 
这是另一种方式吗。
 
当做
 
直率的

Lee Mac 发表于 2022-7-5 18:44:27

请参见此示例:Visual LISP中的实体图案填充

CadFrank 发表于 2022-7-5 19:09:35

谢谢李,总是那么乐于助人。
 
干杯

Lee Mac 发表于 2022-7-5 19:21:25

不客气-我希望这会有所帮助!

VVA 发表于 2022-7-5 19:29:25

ElpanovEvgeniy的entmakex舱口

(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
)
)
页: [1]
查看完整版本: 图案填充创建例程