Разметка линии блоком только по концам данной линии

Neznayka · 10.03.2011, 10:52

Есть много полилиний,
есть команда РАЗМЕТИТЬ, которая ориентирует блок вдоль полилинии, но как мне сориентировать блок только в начале и конце выбранной линии(линий)

Лиспер · 10.03.2011, 11:18

Вручную или программно?

Neznayka · 10.03.2011, 12:06

Да хоть как

Лиспер · 10.03.2011, 12:29

Ну так поставить вручную с поворотом блок - чем не решение?

Neznayka · 10.03.2011, 13:09

проблема в количестве, трудно монотонно отслеживать концы линии

Alan · 10.03.2011, 13:21

Цитата:

Сообщение от Neznayka

проблема в количестве, трудно монотонно отслеживать концы линии

Тогда программно надо...
Алгоритм прост: набор примитивов-линий; цикл по нему _insert в точку начала и конца.

Лиспер · 11.03.2011, 08:54

Сейчас у меня вопрос: а вставку блоков надо выполнять только в начале и конце кривой или по ней тоже расставлять надо? Ну, нечто типа модификации стандартной _.divide?

Neznayka · 11.03.2011, 09:43

вставку блоков надо выполнять только в начале и конце кривой

Хмурый · 11.03.2011, 09:51

команда _measure . Если ввести длину всей кривой, то на одном конце отрисуется блок

Alan · 11.03.2011, 13:08

Цитата:

Сообщение от Neznayka

вставку блоков надо выполнять только в начале и конце кривой

Ну так не очень

профессионально, но программно...

Код:

[Выделить все]

 (setq Cnt 0
      nab (ssget '((0 . "LWPOLYLINE"))))
(repeat    (sslength nab)
  (setq    ml  (entget (ssname nab cnt))
             pt1 (cdr (assoc 10 ml))  ; первая вершина
             ml  (reverse ml)    
             pt2 (cdr (assoc 10 ml))              ; последняя вершина 
  ) ;_ конец setq
  (command "_.-Insert" "Имя_Блока" pt1 1 1 0)
  (command "_.-Insert" "Имя_Блока" pt2 1 1 0)
  (setq cnt (1+ cnt))
) ;_ конец repeat

Сделано без проверок nab на nil и т.п. Если это то что надо, можно довести до ума.

Neznayka · 13.03.2011, 00:18

Хмурый, это вообще задротство

. В моем случае проще уж в рукопашную
Alan, Спасибо
Знаете получилось!
Прогнал на тестовом файле. Все ОК. Хоть и не "крутит блок", но мне уже концы линии не надо выискивать.
А я уже морально приготовился к нудному понедельнику

СПАСИБО!

Кулик Алексей aka kpblc · 13.03.2011, 01:13

Код:

[Выделить все]

 (vl-load-com)

(defun c:blk-to-curve (/ adoc curve blk_ref space)
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (if (and (= (type (setq curve (vl-catch-all-apply
                                  (function
                                    (lambda ()
                                      (car (entsel "\nУкажите кривую <Отмена> : "))
                                      ) ;_ end of lambda
                                    ) ;_ end of function
                                  ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'ename
              ) ;_ end of =
           (wcmatch (cdr (assoc 0 (entget curve))) "*LINE")
           (= (type (setq blk_ref (vl-catch-all-apply
                                    (function
                                      (lambda ()
                                        (car (entsel "\nУкажите блок <Отмена> : "))
                                        ) ;_ end of lambda
                                      ) ;_ end of function
                                    ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'ename
              ) ;_ end of =
           (wcmatch (cdr (assoc 0 (entget blk_ref))) "INSERT")
           ) ;_ end of and
    (foreach pt (list (vlax-curve-getstartpoint curve)
                      (vlax-curve-getendpoint curve)
                      ) ;_ end of list
      (entmakex
        (subst (cons 50 (angle '(0. 0.) (vlax-curve-getfirstderiv curve (vlax-curve-getparamatpoint curve pt))))
               (assoc 50 (entget blk_ref))
               (subst (cons 10 pt)
                      (assoc 10 (entget blk_ref))
                      (vl-remove-if
                        (function
                          (lambda (x)
                            (member (car x) '(-1 5 330))
                            ) ;_ end of lambda
                          ) ;_ end of function
                        (entget blk_ref)
                        ) ;_ end of vl-remove-if
                      ) ;_ end of subst
               ) ;_ end of subst
        ) ;_ end of entmakex
      ) ;_ end of foreach
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

P.S. Проверялось только в мировой системе координат.

Neznayka · 14.03.2011, 00:35

Кулик Алексей aka kpblc, вот это вещь!
Спасибо!
Я абсолютно не претендую на обновление лиспа, но ради критики отмечу что:
- лисп отказывается работать дальше, если промахнулся по линии,
- нет автоматического повтора
-нет памяти на уже выбранный блок.

Кстати, неужели со своей проблемой, только, я один столкнулся? имхо функции этого лиспа подойдут для очевидной модернизации штатной команды РАЗМЕТИТЬ.

Кулик Алексей aka kpblc · 14.03.2011, 01:45

Сейчас все настройки берутся с указанного блока, в том числе и масштабы, и цвет, и слой, и тип линии... Пока что сделал так, на дальнейшее меня уже не хватат

Спать хоцца

Код практически не проверял.

Код:

[Выделить все]

 (vl-load-com)

(defun c:blk-to-curve (/ adoc selset blk_ref space)
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (if (and (= (type (setq selset (vl-catch-all-apply
                                   (function
                                     (lambda ()
                                       (ssget '((0 . "*LINE")))
                                       ) ;_ end of lambda
                                     ) ;_ end of function
                                   ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'pickset
              ) ;_ end of =
           (cond
             ((not *dwgru-block-to-place*)
              (and (= (type (setq blk_ref (vl-catch-all-apply
                                            (function
                                              (lambda ()
                                                (car (entsel "\nУкажите блок <Отмена> : "))
                                                ) ;_ end of lambda
                                              ) ;_ end of function
                                            ) ;_ end of vl-catch-all-apply
                                  ) ;_ end of setq
                            ) ;_ end of type
                      'ename
                      ) ;_ end of =
                   (wcmatch (cdr (assoc 0 (entget blk_ref))) "INSERT")
                   (setq *dwgru-block-to-place* blk_ref)
                   ) ;_ end of and
              )
             (t
              (setq
                blk_ref (vl-catch-all-apply
                          (function
                            (lambda ()
                              (car (entsel (strcat "\nУкажите блок <"
                                                   (vla-get-effectivename (vlax-ename->vla-object *dwgru-block-to-place*))
                                                   "> : "
                                                   ) ;_ end of strcat
                                           ) ;_ end of entsel
                                   ) ;_ end of car
                              ) ;_ end of lambda
                            ) ;_ end of function
                          ) ;_ end of vl-catch-all-apply
                ) ;_ end of setq
              (cond
                ((vl-catch-all-error-p blk_ref)
                 (vla-endundomark adoc)
                 (princ)
                 (exit)
                 )
                ((and (= (type blk_ref) 'ename)
                      (= (cdr (assoc 0 (entget blk_ref))) "INSERT")
                      ) ;_ end of and
                 (setq *dwgru-block-to-place* blk_ref)
                 )
                (t *dwgru-block-to-place*)
                ) ;_ end of cond
              )
             ) ;_ end of cond
           ) ;_ end of and
    (foreach curve ((lambda (/ tab item)
                      (repeat (setq tab  nil
                                    item (sslength selset)
                                    ) ;_ end setq
                        (setq tab (cons (ssname selset (setq item (1- item))) tab))
                        ) ;_ end of repeat
                      ) ;_ end of lambda
                    )
      (foreach pt (list (vlax-curve-getstartpoint curve)
                        (vlax-curve-getendpoint curve)
                        ) ;_ end of list
        (entmakex
          (subst (cons 50 (angle '(0. 0.) (vlax-curve-getfirstderiv curve (vlax-curve-getparamatpoint curve pt))))
                 (assoc 50 (entget *dwgru-block-to-place*))
                 (subst (cons 10 pt)
                        (assoc 10 (entget *dwgru-block-to-place*))
                        (vl-remove-if
                          (function
                            (lambda (x)
                              (member (car x) '(-1 5 330))
                              ) ;_ end of lambda
                            ) ;_ end of function
                          (entget *dwgru-block-to-place*)
                          ) ;_ end of vl-remove-if
                        ) ;_ end of subst
                 ) ;_ end of subst
          ) ;_ end of entmakex
        ) ;_ end of foreach
      ) ;_ end of foreach
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

10.03.2011, 10:52		#1
Разметка линии блоком только по концам данной линии Neznayka Регистрация: 24.03.2005 Сообщений: 320 Есть много полилиний, есть команда РАЗМЕТИТЬ, которая ориентирует блок вдоль полилинии, но как мне сориентировать блок только в начале и конце выбранной линии(линий)
Просмотров: 4105

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Создание нового типа линий	Apelsinov	AutoCAD	915	08.07.2022 12:36
разметка на линии отрезков заданной длинны	dvernik	AutoCAD	5	13.03.2009 17:11
Как сгладить 2 линии. Или как сгладить только часть линии.	Димас	AutoCAD	3	14.03.2006 08:28