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

Вернуться   Форум DWG.RU > Программное обеспечение > AutoCAD > Есть ли возможность вставить в вершины полилинии блоки?

Есть ли возможность вставить в вершины полилинии блоки?

Ответ
Поиск в этой теме
Непрочитано 28.07.2007, 15:26
Есть ли возможность вставить в вершины полилинии блоки?
bimari
 
проектирование дорог
 
Riga
Регистрация: 18.10.2006
Сообщений: 25

Есть ли возможность автоматически вставить в вершины полилинии одинаковые блоки для того, чтобы обозначить места изгиба. Трасса очень длинная, поэтому вручную это делать нецелесообразно.
Заранее спасибо.
Просмотров: 5131
 
Непрочитано 14.07.2019, 16:50
#21
superkot007


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


Добрый день!
Помогите, пожалуйста, модернизировать лисп уважаемого Алексея, чтобы можно было выбирать несколько полилиний секущей рамкой:
Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Еще вариант:
Код:
[Выделить все]
(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
Или, если встречался готовый лисп по расстановке блоков в вершинах 3D-полилиний, подскажите, пожалуйста, где скачать. Поиском пользовался, но ничего подходящего найти не смог.
superkot007 вне форума  
 
Непрочитано 14.07.2019, 19:16
#22
VVA

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


superkot007,
Цитата:
Сообщение от superkot007 Посмотреть сообщение
ли, если встречался готовый лисп по расстановке блоков в вершинах 3D-полилиний,
Я код не проверял, по листингу он работает с 3d полилиниями
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 14.07.2019 в 19:32.
VVA вне форума  
 
Непрочитано 14.07.2019, 21:04
#23
Кулик Алексей aka kpblc
Moderator

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


Примерно так (код не проверял):
Код:
[Выделить все]
 (defun c:ins2pline (/ adoc space selset 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
  (defun _kpblc-conv-selset-to-ename (selset / tab item)
                                     ;|
*    Преобразование набора, полученного через ssget, в список ename-представлени
* примитивов.
*    Параметры вызова:
  selset  ; набор примитивов
*    Примеры вызова:
(_kpblc-conv-selset-to-ename (ssget))
|;  (cond ((not selset) nil)
          ((= (type selset) 'pickset)
           (repeat (setq tab  nil
                         item (sslength selset)
                         ) ;_ end setq
             (setq tab (cons (ssname selset (setq item (1- item))) tab))
             ) ;_ end repeat
           )
          ((= (type selset) 'vla-object) (_kpblc-conv-vla-to-list selset))
          ((listp selset) (mapcar (function _kpblc-conv-ent-to-ename) selset))
          ) ;_ end of cond
    ) ;_ end of defun
  (vl-load-com)
  (if (and (= (type (setq selset (vl-catch-all-apply (function (lambda () (ssget '((0 . "*POLYLINE")))))))
                    'pickset
                    ) ;_ end of type
              ) ;_ end of =
           (not (vl-catch-all-error-p
                  (vl-catch-all-apply '(lambda () (setq blk (car (entsel "\nА теперь блок <Отмена> : ")))))
                  ) ;_ end of vl-catch-all-error-p
                ) ;_ end of not
           blk
           (wcmatch (strcase (cdr (assoc 0 (entget blk)))) "*INSERT")
           ) ;_ end of and
    (progn (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
           (foreach ent (mapcar (function vlax-ename->vla-object) (_kpblc-conv-selset-to-ename selset))
             (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)
                                 (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 _kpblc-conv-list-to-3dpoints
                                 )
                                ) ;_ end of cond
                   ) ;_ end of setq
             (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 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
             ) ;_ end of foreach
           (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
           ) ;_ end of progn
    ) ;_ end of if
  (princ)
  ) ;_ end of defun
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 15.07.2019, 20:48
#24
superkot007


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


Кулик Алексей aka kpblc,
выбор нескольких объектов появился, но далее пишет "; ошибка: слишком много аргументов"(

VVA, вариант из #5 работает только с одной 3D-полилинией. Нельзя выбрать несколько секущей рамкой или выбором подобных.
superkot007 вне форума  
 
Непрочитано 16.07.2019, 22:02
#25
VVA

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


Поправил
Код:
[Выделить все]
 
 (defun c:ins2pline (/ adoc space selset blk ent ins coords _kpblc-conv-list-to-3dpoints _kpblc-conv-ent-pline-vertex-to-wcs name)
  (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
  (defun _kpblc-conv-selset-to-ename (selset / tab item)
                                     ;|
*    Преобразование набора, полученного через ssget, в список ename-представлени
* примитивов.
*    Параметры вызова:
  selset  ; набор примитивов
*    Примеры вызова:
(_kpblc-conv-selset-to-ename (ssget))
|;  (cond ((not selset) nil)
          ((= (type selset) 'pickset)
           (repeat (setq tab  nil
                         item (sslength selset)
                         ) ;_ end setq
             (setq tab (cons (ssname selset (setq item (1- item))) tab))
             ) ;_ end repeat
           )
          ((= (type selset) 'vla-object) (_kpblc-conv-vla-to-list selset))
          ((listp selset) (mapcar (function _kpblc-conv-ent-to-ename) selset))
          ) ;_ end of cond
    ) ;_ end of defun
  (vl-load-com)
  (if (and (= (type (setq selset (vl-catch-all-apply (function (lambda () (ssget '((0 . "*POLYLINE")))))))
                    ) ;_ end of type
              'pickset
              ) ;_ end of =
           (not (vl-catch-all-error-p
                  (vl-catch-all-apply '(lambda () (setq blk (car (entsel "\nА теперь блок <Отмена> : ")))))
                  ) ;_ end of vl-catch-all-error-p
                ) ;_ end of not
           blk
           (wcmatch (strcase (cdr (assoc 0 (entget blk)))) "*INSERT")
           (setq blk (vlax-ename->vla-object blk))
           ) ;_ end of and
    (progn (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
           (foreach ent (mapcar (function vlax-ename->vla-object) (_kpblc-conv-selset-to-ename selset))
             (setq space  (vla-objectidtoobject (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
                                                (vla-get-ownerid  ent)
                                                ) ;_ end of vla-ObjectIDToObject
                   name    (cond ((vlax-property-available-p  blk 'effectivename)
                                 (vla-get-effectivename blk)
                                 )
                                (t (vla-get-name blk))
                                ) ;_ end of cond
                   coords (cond ((= (strcase (cdr (assoc 0 (entget (vlax-vla-object->ename ent))))) "LWPOLYLINE") (_kpblc-conv-ent-pline-vertex-to-wcs (vlax-vla-object->ename ent)))
                                (t
                                 (_kpblc-conv-list-to-3dpoints
                                   (vlax-safearray->list (vlax-variant-value (vla-get-coordinates ent)))
                                   ) ;_ end of _kpblc-conv-list-to-3dpoints
                                 )
                                ) ;_ end of cond
                   ) ;_ end of setq
             (foreach pt coords
               (if (vl-catch-all-error-p
                     (vl-catch-all-apply
                       (function (lambda () (setq ins (vla-insertblock space (vlax-3d-point pt) name 1. 1. 1. 0.))))
                       ) ;_ 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
             ) ;_ end of foreach
           (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
           ) ;_ end of progn
    ) ;_ end of if
  (princ)
  ) ;_ end of defun
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > AutoCAD > Есть ли возможность вставить в вершины полилинии блоки?

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

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