Реклама i
Стань нашим партнером - зарабатывай с нами!
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Блоки по вершинам полилинии

Блоки по вершинам полилинии

Ответ
Поиск в этой теме
Непрочитано 25.11.2019, 21:52 #1
Блоки по вершинам полилинии
lakebay
 
Регистрация: 25.11.2019
Сообщений: 2

Здравствуйте! На просторах интернета нашел Lisp, который автоматически вставляет блоки по вершинам полилинии. Как работает: вызываем ins2pline, выбираем необходимую полилинию, выбираем блок, ентер и вуаля. Но есть проблема: вставляются блоки в их нулевом виде. Вот в этом мне нужна помощь: как подредактировать код так, чтобы прога копировала свойства вставляемого блока (а точнее, слой, в котором в выбираемый блок, и его состояние видимости)?
Это первое. Второе по-сложнее: может ли кто на коленке написать код, чтобы вместо полилинии выбирать точки? То есть выбираем циклически несколько точек, выбираем блок, ентер и вуаля) Заранее спасибо. Код внизу
Код:
[Выделить все]
 (defun c:ins2pline (/                      adoc
                    space                  blk
                    ent                    ins
                    coords                 _kpblc-conv-list-to-3dpoints
                    _kpblc-conv-ent-pline-vertex-to-wcs
                    )

  (defun _kpblc-conv-list-to-3dpoints (lst / res)
                                      ;|
*    Функция конвертации списка чисел в список 3-мерных точек.
*    Параметры вызова:
*	lst	список чисел
*    Примеры вызова:
(_kpblc-conv-list-to-3dpoints '(1 2 3 4 5 6)) ;-> ((1 2 3) (4 5 6))
(_kpblc-conv-list-to-3dpoints '(1 2 3 4 5))   ;-> ((1 2 3) (4 5 0.))
|;
    (cond
      ((not lst)
       nil
       )
      (t
       (setq res (cons (list (car lst)
                             (if (cadr lst)
                               (cadr lst)
                               0.
                               ) ;_ end of if
                             (if (caddr lst)
                               (caddr lst)
                               0.
                               ) ;_ end of if
                             ) ;_ end of list
                       (_kpblc-conv-list-to-3dpoints (cdddr lst))
                       ) ;_ end of cons
             ) ;_ end of setq
       )
      ) ;_ end of cond
    res
    ) ;_ end of defun

  (defun _kpblc-conv-ent-pline-vertex-to-wcs (ent / elevation normal)
                                             ;|
*    Функция получения координат легкой полилинии (LWPOLYLINE) в WCS. Возвращает
* список 3Д-точек
*    Автор: BOZ (http://www.autocad.ru/cgi-bin/f1/board.cgi?t=26461HC)
*    Оригинальный код:
(defun lwpoly_vert (lwpoly / plinee elev vnv)
  (setq	plinee (entget lwpoly)
	elev   (cdr (assoc 38 plinee))
	vnv    (cdr (assoc 210 plinee))
	) ;_ end of setq
  (mapcar
    (function (lambda (x) (trans (list (cadr x) (caddr x) elev) vnv 0)))
    (vl-remove-if-not (function (lambda (x) (= (car x) 10))) plinee)
    ) ;_ end of mapcar
  ) ;_ end of defun
*    Параметры вызова:
*	ent	ename-указатель на LWPOLYLINE (контроля не производится)
*    Примеры вызова:
(_kpblc-conv-ent-pline-vertex-to-wcs (car (entsel)))
|;
    (setq elevation (cdr (assoc 38 (entget ent)))
          normal    (cdr (assoc 210 (entget ent)))
          ) ;_ end of setq
    (if (not elevation)
      (setq elevation 0.)
      ) ;_ end of if
    (mapcar '(lambda (x) (trans (list (cadr x) (caddr x) elevation) normal 0))
            (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))
            ) ;_ end of mapcar
    ) ;_ end of defun

  (vl-load-com)
  (if
    (and
      (not (vl-catch-all-error-p
             (vl-catch-all-apply
               '(lambda ()
                  (setq ent (car (entsel "\nУкажите полилинию <Отмена> : ")))
                  ) ;_ end of lambda
               ) ;_ end of vl-catch-all-apply
             ) ;_ end of vl-catch-all-error-p
           ) ;_ end of not
      ent
      (wcmatch (strcase (cdr (assoc 0 (entget ent)))) "*POLYLINE")
      (not
        (vl-catch-all-error-p
          (vl-catch-all-apply
            '(lambda () (setq blk (car (entsel "\nА теперь блок <Отмена> : "))))
            ) ;_ end of vl-catch-all-apply
          ) ;_ end of vl-catch-all-error-p
        ) ;_ end of not
      blk
      (wcmatch (strcase (cdr (assoc 0 (entget blk)))) "*INSERT")
      ) ;_ end of and
     (progn
       (setq space  (vla-objectidtoobject
                      (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
                      (vla-get-ownerid (vlax-ename->vla-object ent))
                      ) ;_ end of vla-ObjectIDToObject
             blk    (cond
                      ((vlax-property-available-p
                         (setq blk (vlax-ename->vla-object blk))
                         'effectivename
                         ) ;_ end of vlax-property-available-p
                       (vla-get-effectivename blk)
                       )
                      (t (vla-get-name blk))
                      ) ;_ end of cond
             coords (cond
                      ((= (strcase (cdr (assoc 0 (entget ent)))) "LWPOLYLINE")
                       (_kpblc-conv-ent-pline-vertex-to-wcs ent)
                       )
                      (t
                       (_kpblc-conv-list-to-3dpoints
                         (vlax-safearray->list
                           (vlax-variant-value
                             (vla-get-coordinates (vlax-ename->vla-object ent))
                             ) ;_ end of vlax-variant-value
                           ) ;_ end of vlax-safearray->list
                         ) ;_ end of _kpblc-conv-list-to-3dpoints
                       )
                      ) ;_ end of cond
             ) ;_ end of setq
       (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
       (foreach pt coords
         (if
           (vl-catch-all-error-p
             (vl-catch-all-apply
               (function
                 (lambda ()
                   (setq ins (vla-insertblock
                               space
                               (vlax-3d-point pt)
                               blk
                               1.
                               1.
                               1.
                               0.
                               ) ;_ end of vla-insertblock
                         ) ;_ end of setq
                   ) ;_ end of lambda
                 ) ;_ end of function
               ) ;_ end of vl-catch-all-apply
             ) ;_ end of vl-catch-all-error-p
            (vl-catch-all-apply '(lambda () (vla-erase ins)))
            ) ;_ end of if
         ) ;_ end of foreach
       (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
       ) ;_ end of progn
     ) ;_ end of if
  (princ)
  ) ;_ end of defun
Просмотров: 2098
 
Непрочитано 25.11.2019, 22:40
#2
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Исходник тута? https://forum.dwg.ru/showthread.php?t=117722

Вариантов несколько: либо сначала установить соответствующие переменные, а потом выполнять копирование исходного вхождения; либо - посмотреть, в чем разница между EffectiveName и Name для вхождения блока, и заодно посмотреть, что возвращает vla-insertblock. Там все достаточно просто, но лично мне заниматься лениво. Спать охота...
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 25.11.2019, 22:50
#3
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,004


lakebay, Может это вам поможет?
Сергей812 вне форума  
 
Непрочитано 30.11.2019, 12:35
#4
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


FRTO
LISP. Замена набора примитивов на выбранный примитив
Как преобразовать точки в блоки?
Замена ряда одних объектов другими
Можно ли автоматически расставить блоки по центрам окружностей?
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 22.02.2024, 12:31
#5
_A_x_e_l_


 
Регистрация: 31.01.2023
Сообщений: 2


Добрый день, подскажите пож-та, пользуюсь данными лиспами давно (вам большое спасибО), но часто возникает задача расстановки блоков с привязкой базовой точки в первую вершину полилиний (пример test прикрепил).
https://www.caduser.ru/forum/topic21135.html , VVA писал что это требует переработки всей программы.
Может кто то сталкивался и уже есть готовый вариант (поиск по сайту и другим источникам результатов не дали), только нашел частично подходящий вариант от КЕНТ, "Аналог FRTO", с возможностью выбора точки вставки у блока, а у полилиний это центр.
Вложения
Тип файла: dwg
DWG 2013
test.dwg (41.3 Кб, 0 просмотров)
Тип файла: lsp frt.lsp (2.8 Кб, 0 просмотров)
Тип файла: lsp frto.lsp (5.6 Кб, 0 просмотров)
_A_x_e_l_ вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Блоки по вершинам полилинии

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как добавить вершины в полилинии в тех местах, где на не находятся блоки? reddiska Программирование 10 10.07.2016 08:39
Объекты (блоки) в вершинах полилинии... не тривиальный вопрос Arty_B84 AutoCAD 9 21.07.2013 23:15
Создание полилинии связывающей блоки Костин Павел Сергеевич Программирование 20 22.02.2010 14:41
Как вставить блоки по направлению полилинии (VBA) dorofei Программирование 5 27.11.2006 06:50