• Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Тема: LISP.lib Создание штриховки через entmakex

Сегодня меня попросили помочь, создать штриховку, без использования контуров и объектных методов. Контура имеют только линейные сегменты.
Потом уговорили выложить программу, так и делаю.
В программу передается список, со списками вершин контуров, они могут быть вложенными или пересекающимися...
В программе создается штриховка - "SOLID", если кому то нужно, уверен, вы сможете доделать.
В крайнем случае обращайтесь - помогу...

(defun entmakex-hatch (L)
 ;; By ElpanovEvgeniy
 ;; 03.04.2007
 (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 . "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
           )
    '((75 . 0)
      (76 . 1)
      (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
  ) ;_  apply
 ) ;_  entmakex
)

Пример вызова

(setq
 h (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))
     )
   ) ;_  entmakex-hatch
) ;_  setq

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: LISP.lib Создание штриховки через 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.
)

  • Vovka
  • Восстановленный участник
  • На форуме с 21 января 2007г.
  • Сообщений: 328
  • Спасибо: 1

Re: LISP.lib Создание штриховки через entmakex

dxf коды, имеющие отношение к градиентам, желательно убрать, для совместимости со старыми версиями Акада