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

bimari · 28.07.2007, 15:26

Есть ли возможность автоматически вставить в вершины полилинии одинаковые блоки для того, чтобы обозначить места изгиба. Трасса очень длинная, поэтому вручную это делать нецелесообразно.
Заранее спасибо.

Кулик Алексей aka kpblc · 28.07.2007, 16:40

Лиспом, конечно, можно. Если вопрос "при прорисовке" - то не знаю, по-моему, нельзя.

VVA · 30.07.2007, 11:12

Вставка блоков в точки, совпадающие с вершинами выбранной полилинии

Кочетков Андрей · 30.07.2007, 12:31

Я пользуюсь тулпаковской командой PMV

Кулик Алексей aka kpblc · 30.07.2007, 13:02

Еще вариант:

Код:

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

(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

VVA · 26.03.2017, 10:39

Попросили найти лисп, вставляющий блоки в вершины полилинии с углом поворота по бисектрисе. Может кому пригодится

Нажмите на изображение для увеличения
Название: blockline.JPG
Просмотров: 285
Размер: 44.2 Кб
ID: 185636

Код:

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

;;;Insert Block in vertex of polyline
;;;https://www.theswamp.org/index.php?topic=41621.0
;;;http://forum.dwg.ru/showthread.php?p=1631456#post1631456
(defun C:A3 (/ pl lst bname)
  (setq bname (getstring "\nEnter block name <Pick>"))
  (if (eq bname "")
    (progn
      (setq pl (ssget "_:E:S" '((0 . "INSERT"))))
      (setq bname (block-get-name(ssname pl 0)))
      )
    )
  (if (tblsearch "block" bname)
    (progn
      (setq pl (car (entsel "\nSelect polyline: ")))
      (if (wcmatch (cdr (assoc 0 (entget pl))) "*POLYLINE")
	(progn
	  (setq lst (lwpoly_vert pl))
	  (insert (car lst) (angle (car lst) (cadr lst)) bname)
	  (mapcar '(lambda (p1 p2 p3 / p4 ang)
		     (setq ang (* 0.5 (LM:GetInsideAngle p1 p2 p3)))
		     (setq
		       p4 (polar p1 (angle p1 p3) (* 0.5 (distance p1 p3)))
		     )

		     (if (minusp (sideof p1 p2 p4))
		       (setq ang (+ (angle p1 p2) ang))
		       (setq ang (- (angle p1 p2) ang))
		     )
		     (setq ang (+ (* 0.5 pi) ang))
		     (insert p2 ang bname)
		   )
		  lst
		  (cdr lst)
		  (cddr lst)
	  )
	  (setq lst (reverse lst))
	  (insert (car lst) (angle (car lst) (cadr lst)) bname)
	)
      )
    )
    (alert (strcat "Block " bname " not found"))
  )
)
;; Get Inside Angle  -  Lee Mac
;; Returns the smaller angle subtended by three points with vertex at p2
(defun LM:GetInsideAngle ( p1 p2 p3 )
    (   (lambda ( a ) (min a (- (+ pi pi) a)))
        (rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi))
    )
)
(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
(defun Insert (pt ang Nme)
  (entmakex (list (cons 0 "INSERT")
                  (cons 2 Nme)
                  (cons 10 pt)
		  (cons 50 ang)
		  )
	    )
  )
;;; D. C. Broad, Jr.
;;;  (sideof <ray-origin> <another-point-on-ray> <point-to-be-tested>)
;;;  return values
;;;  negative = point is to the right side of the ray
;;;  0 = point is on the ray
;;;  otherwise point is on the left side of the ray.
;;;  P1 should not equal P2 for meaningful results.
  (defun sideof (p1 p2 p / r)
    (setq r (cond
              ((equal p1 p 1e-10) 0)
              (t (sin (- (angle p1 p) (angle p1 p2))))
            )
    )
    (if (equal r 0 1e-10) 0 r)
  )
(defun block-get-name (blockentity / name repbtag )
  (if (eq (type blockentity) 'VLA-OBJECT)(setq blockentity (vlax-vla-object->ename blockentity)))
;;;get from Lee Mac  LM:EffectiveName
;;; http://www.theswamp.org/index.php?topic=37493.0
;;; http://forum.dwg.ru/showthread.php?t=65082
;;----------------=={ Effective Block Name }==----------------;;
;;                                                            ;;
;;  Returns the effective name of a block.                    ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  blockentity - Block Reference Entity name                 ;;
;;------------------------------------------------------------;;
;;  Returns:  True block name as per the block definition     ;;
;;------------------------------------------------------------;;
 
  (if (wcmatch (setq name (cdr (assoc 2 (entget blockentity)))) "`**")
    (if
      (and
        (setq repbtag
          (cdadr
            (assoc -3
              (entget
                (cdr
                  (assoc 330
                    (entget (tblobjname "BLOCK" name))
                  )
                )
               '("AcDbBlockRepBTag")
              )
            )
          )
        )
        (setq repbtag (handent (cdr (assoc 1005 repbtag))))
      )
      (setq name (cdr (assoc 2 (entget repbtag))))
    )
  )
  name
)             
(princ "\nType A3 in command line")(princ)

config · 27.03.2017, 09:29

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

VVA · 28.03.2017, 18:54

config, Добавил

Цитата:

Команда: a3
Enter block name <Pick>

Обновил #6

config · 28.03.2017, 19:26

Цитата:

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

config, Добавил

Спасибо огромное!

Without_nick · 29.10.2018, 13:11

VVA, прежде всего, огромное спасибо за Ваши лиспы.
Помогите, пожалуйста, у меня есть блок с атрибутом, и после использования лиспа А3, нет возможности "прописать" этот самый атрибут.

Кулик Алексей aka kpblc · 29.10.2018, 13:15

Это явно не просто блок, а объект какой-то вертикалки (Map / Civil).

Without_nick · 29.10.2018, 13:26

Кулик Алексей aka kpblc, обычный динамический блок, в нем только атрибут и выравнивание

Кулик Алексей aka kpblc · 29.10.2018, 13:54

Обычный блок не покажет в панели свойств какую-то "Кан_ливн - Нумерация". Открой чистый ACAD и создай дин.блок - увидишь разницу.

Without_nick · 29.10.2018, 14:20

Это название блока.
Создала точно такой же блок в чистом ACAD (только название блока другое). Вроде точно такой же, но могу ошибаться

Кулик Алексей aka kpblc · 29.10.2018, 15:25

Файл можно глянуть с одним этим блоком?

Without_nick · 29.10.2018, 15:33

Конечно.
Версия ACAD 14, сохранен в 07. Не уверена, но мне кажется, что вертикалки у нас вообще нет (не видела, не знаю, как они выглядат).

Кулик Алексей aka kpblc · 29.10.2018, 16:08

При открытии:

После очистки прокси-объектов получился dwg (см.аттач)
При сохранении:

Setvar · 29.10.2018, 16:27

На русском языке:

kacugu · 29.10.2018, 17:02

Да и названия вкладок намекают

Without_nick · 30.10.2018, 09:03

Всем спасибо!

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

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