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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Добавление в чертеж длины полилинии

Добавление в чертеж длины полилинии

Ответ
Поиск в этой теме
Непрочитано 01.08.2007, 11:25
Добавление в чертеж длины полилинии
Кочетков Андрей
 
Java/Kotlin backend
 
Регистрация: 03.02.2006
Сообщений: 5,736

Господа программисты, нужна ваша помощь.

Мне нужна программа которая делает следующее:

тыркаем в полилинию, затем тыркаем в произвольную точку чертежа и в этой точке создается текст, содержимым которого является длина раннее "тыркнутой" полилинии.

Попытался сам сделать, но на создании текста застопорился, а на эксперименты нет времени.
Просмотров: 16234
 
Непрочитано 01.08.2007, 16:17
#21
Neznayka


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


VVA, спасибо за модификацию
Neznayka вне форума  
 
Непрочитано 01.08.2007, 16:50
#22
VVA

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


Код:
[Выделить все]
;|============================================================================== 
*  Получение списка списков точек вершин ВЭ листа в координатах листа и модели 
*  Если ВЭ не существует, возвращает nil. 
*  Структура списка ((Точки_ВЭ1_Лист Точки_ВЭ1_Модель ename_ВЭ1) ... (Точки_ВЭN_Лист Точки_ВЭN_Модель ename_ВЭN))
*  Смотреть
*  http://www.autocad.ru/cgi-bin/f1/board.cgi?t=27187wE
*  http://www.arcada.com.ua/forum/viewtopic.php?t=850
*  layuot - имя листа (getvar "CTAB") или (LAYOUTLIST)
*  Возвращает список ((Точки_ВЭ1_Лист Точки_ВЭ1_Модель ename_ВЭ1) ... (Точки_ВЭN_Лист Точки_ВЭN_Модель ename_ВЭN)) 
=============================================================================|; 
(defun _mip-get-point-viewport ( layout / t10 t12 m res1 res2 nb) 
 (mapcar  '(lambda ( y / res1 x)(setq x (entget y))
  (if (cdr (assoc 340 x))
  (setq res1 (mapcar 'cdr (vl-remove-if-not '(lambda (b) (= (car b) 10))
			    (entget (cdr (assoc 340 x))))))
  (setq res1 (list
	       (list (- (cadr (assoc 10 x))(/ (cdr (assoc 40 x)) 2.))
		     (- (caddr (assoc 10 x))(/ (cdr (assoc 41 x)) 2.)))
               (list (+ (cadr (assoc 10 x))(/ (cdr (assoc 40 x)) 2.)) 
                     (- (caddr (assoc 10 x))(/ (cdr (assoc 41 x)) 2.)))
               (list (+ (cadr (assoc 10 x))(/ (cdr (assoc 40 x)) 2.)) 
                     (+ (caddr (assoc 10 x))(/ (cdr (assoc 41 x)) 2.)))
               (list (- (cadr (assoc 10 x))(/ (cdr (assoc 40 x)) 2.)) 
                     (+ (caddr (assoc 10 x)) (/ (cdr (assoc 41 x)) 2.))))))
     (setq t10 (cdr(assoc 10 x));_Координаты центра ВЭ в листе 
           t12 (if (equal (cdr(assoc 17 x)) '(0 0 0) 1e-6)(cdr(assoc 12 x))(cdr(assoc 17 x)));_Координаты центра ВЭ в Модели 
             m (/ (cdr(assoc 45 x))(cdr(assoc 41 x))) ;_Коэфф. пересчета в модель 
          res2 (mapcar '(lambda(y)(mapcar '+ (mapcar '* (mapcar '- y t10)(list m m m)) t12)) res1)) 
          (list res1 res2 y)) ;_ end of lambda
          ;;;69 1 - исключаем vieport
       (vl-remove-if '(lambda (x)(member (cons 69 1) (entget x)))
	 (if (setq nb (setq nb (ssget "_X" (list '(0 . "VIEWPORT")
                                                 '(-4 . "<>")
                                                 '(69 . 1)
                                                 (cons 410 layout)))))
		   (vl-remove-if 'listp (mapcar 'cadr (ssnamex nb)))
		   nil))) ;_ end of mapcar
  ) ;_ end of defun 



;; obj - vla object
(defun lenobj ( obj / len sum_len)
(setq sum_len 0)  
(cond
       	 ((= (strcase (vla-get-objectname obj)) "ACDBMLINE")
	  (setq ent (entget(vlax-vla-object->ename obj)))
	  (setq len (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= 11 (car x)))) ent)))
	  (if (= 2 (logand 2 (cdr(assoc 71 ent))))(setq len (append len (list (car len)))))
	  (setq ds (car len))
          (setq sum_len (+ sum_len (apply '+ (mapcar '(lambda(x / dst)(setq dst (distance ds x))(setq ds x) dst) len))))
	 )
         ((vlax-property-available-p obj 'length)
	    (setq sum_len (+ sum_len (if (vl-catch-all-error-p(vl-catch-all-apply '(lambda()(setq len (vla-get-length obj))))) 0 len))))
	 ((member (setq obj_name (strcase (vla-get-objectname obj) t)) '("acdbcircle" "acdbarc" "acdbellipse" "acdbspline"))
            (setq sum_len (+ sum_len 
                            (cond ((= obj_name "acdbcircle")(* 2 pi (vla-get-radius obj))) 
                                  ((= obj_name "acdbarc")(vla-get-ArcLength obj))
                                  ((member obj_name '("acdbellipse" "acdbspline")) 
                                    (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj)))
		                  (t 0.0))))
	  )
         ((and(= (strcase (vla-get-objectname obj)) "ACDBVIEWPORT")
              (setq len (assoc
                (vlax-vla-object->ename obj)
                (mapcar 'reverse (_mip-get-point-viewport (getvar "CTAB")))))
              )
          (setq len (last len)
                len (append len (list (car len)))
                sum_len (apply '+ (mapcar 'distance len (cdr len)))
                )
          )
	 (t nil)
	   )
  sum_len
  )
Код:
[Выделить все]
;; Usage
(lenobj (vlax-ename->vla-object(car(entsel))))
Писал быстро, поэтому не рационально. Использовать как пример
VVA вне форума  
 
Непрочитано 17.03.2010, 10:11
#23
privodnik

ЭС.
 
Регистрация: 15.05.2009
МО
Сообщений: 191


А можно ли сделать так, чтоб проставлялись длины (в виде редактируемых размеров) сегментов плинии прям при нанесении оной на чертеж? ну или образмеривалась существующая.
что хочу на выходе-в примере.

з.ы. да, я археолог)
Вложения
Тип файла: dwg
DWG 2007
пример.dwg (79.7 Кб, 1212 просмотров)
privodnik вне форума  
 
Непрочитано 17.03.2010, 15:21
1 | #24
VVA

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


Цитата:
Сообщение от privodnik Посмотреть сообщение
А можно ли сделать так, чтоб проставлялись длины (в виде редактируемых размеров) сегментов плинии прям при нанесении оной на чертеж?
К сожалению Александр Смирнов сменил род деятельности и перестал заниматься лиспом и Автокадом. Но его творения остались. Одно из них:
Цитата:
PDIM.LSP - This lisp for dimensioning of several LwPolylines simultaneously. The program works with current dimensional style. The distance of the dimensional text from a polyline is equal to multiplication of height of the dimensional text (DIMTEXT system variable) on a variable 'tOff'. You can change value of 'tOff' in the program beginning, after note.
AsmiTools - сборник Lisp программ от Александра Смирнова
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 17.03.2010, 15:42
#25
privodnik

ЭС.
 
Регистрация: 15.05.2009
МО
Сообщений: 191


Спасибо, посмотрим...а на русском описания команд нет?
privodnik вне форума  
 
Непрочитано 17.03.2010, 16:44
1 | #26
VVA

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


Посмотри по ссылке в комментарии
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 26.10.2010, 19:56 длины полилинии
#27
IrinaO


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


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
_.field :?:
помогите, пожалуйста, записать эту самую длину, но не в текст, а в аттрибут блока ( блок создам предварительно). Цель - последующее суммирование этих цифр в экселе.
IrinaO вне форума  
 
Непрочитано 22.04.2013, 17:51
#28
Garand


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


Добрый день!
Можно ли в код из поста №5 добавить возможность извлечения и вставки в другие ячейки таблицы значения мультивыноски и атрибутов блоков?
Причем одним циклом: после выбора таблицы указываю один блок, второй блок, мультивыноску и полилинию, и каждый раз указываю ячейки, куда вставлять данные.
Это все нужно для создания кабельного журнала, т.е. первый атрибут - устройство, откуда идет кабель, второй - куда идет, мультивыноска - номер кабеля и длина полилинии - собственно длина кабеля.
Garand вне форума  
 
Непрочитано 19.01.2014, 12:22
#29
Browning Zed


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


Здравствуйте. Необходим лисп проставляющий длину линии, и при этом, одновременно, происходило бы выравнивание текста параллельно и по центру линии, с реактором (т.е при растягивании линии расположение текста относительно линии должно оставаться прежним). Вот тут уже были попытки сделать подобное, но там выводится поле, а нужен простой текст, чтобы при изменении длины линии, её изначальное значение, проставленное как текст, не менялось бы. Уважаемы знатоки LISP, помогите с решением данной проблемы.
Browning Zed вне форума  
 
Непрочитано 13.02.2019, 09:50
#30
Зодчий1989


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


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Те же яйца, только в профиль:
Что я сделал не так? Acad 2016x64

некорректно идентифицируется ID объекта. это связано с версией ACADa&


Код:
[Выделить все]
 (defun c:flen1 (/ adoc ent pt *error*)
               ;|
*    Вставка полем с последовательным выбором полилиний "по одной"
|;
  (defun loc:unhighlight (ent)
    (vl-catch-all-apply
      '(lambda ()
         (if ent
           (vla-highlight
             (cond
               ((= (type ent) 'ename) (vlax-ename->vla-object ent))
               (t ent)
               ) ;_ end of cond
             :vlax-false
             ) ;_ end of vla-highlight
           ) ;_ end of if
         ) ;_ end of lambda
      ) ;_ end of vl-catch-all-apply
    ) ;_ end of defun

  (defun *error* (msg)
    (loc:unhighlight ent)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (while
    (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)))) "*LINE")
      (setq ent (vlax-ename->vla-object ent))
      ((lambda () (vla-highlight ent :vlax-true) t))
      (not (vl-catch-all-error-p
             (vl-catch-all-apply
               '(lambda ()
                  (setq pt (getpoint "\nТочка вставки результата <Отмена> : "))
                  ) ;_ end of lambda
               ) ;_ end of vl-catch-all-apply
             ) ;_ end of vl-catch-all-error-p
           ) ;_ end of not
      pt
      ) ;_ end of and
     (vla-startundomark adoc)
     (loc:unhighlight ent)
     (vla-addmtext
       (vla-objectidtoobject adoc (vla-get-ownerid ent))
       (vlax-3d-point pt)
       0
       (strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId "
               (vl-princ-to-string (vla-get-objectid ent))
               ">%).Length \\f \"%lu2%pr2%ct8[0.001]\">%"
               ) ;_ end of strcat
       ) ;_ end of vla-AddMText
     (vla-endundomark adoc)
     ) ;_ end of while
  (loc:unhighlight ent)
  (princ)
  ) ;_ end of defun

Последний раз редактировалось Зодчий1989, 13.02.2019 в 10:25.
Зодчий1989 вне форума  
 
Непрочитано 13.02.2019, 11:00
1 | #31
Кулик Алексей aka kpblc
Moderator

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


Это связано с ограничениями LISP: он не умеет оперировать с 64-разрядными целыми. Самое простое решение - это преобразовать объект в ename, вывести его в строку, отфильтровать то, что идет после символа ":", и преобразовать остаток в десятичную систему из 16-ричной. Функции соответствующие на этом форуме, насколько я помню, были.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 13.02.2019, 11:01
1 | #32
Сергей812


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


Цитата:
Сообщение от Зодчий1989 Посмотреть сообщение
некорректно идентифицируется ID объекта. это связано с версией ACADa&
Возможно - тыц (autolisp.ru)
Сергей812 вне форума  
 
Непрочитано 13.02.2019, 12:04
#33
Зодчий1989


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


Цитата:
Сообщение от Сергей812 Посмотреть сообщение
Возможно - тыц (autolisp.ru)
Увы программирование на уровне паскаля( эту проблему данными мне мозгами быстро не решить.
Зодчий1989 вне форума  
 
Непрочитано 13.02.2019, 13:31
#34
Кулик Алексей aka kpblc
Moderator

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


Сергей812, там информация немного устарела. Спасибо, подправлю сегодня (по крайней мере на это надеюсь)
Только что добавил статейку: http://autolisp.ru/2019/02/14/objectid-for-fields/
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.

Последний раз редактировалось Кулик Алексей aka kpblc, 14.02.2019 в 07:51.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 13.02.2019, 15:12
1 | 1 #35
VVA

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


Зодчий1989, Попробуй в строке 60 вместо vla-get-objectid использовать функцию Get-ObjectID-x86-x64

Код:
[Выделить все]
(strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId "
               (vl-princ-to-string (Get-ObjectID-x86-x64  ent))
               ">%).Length \\f \"%lu2%pr2%ct8[0.001]\">%"
               ) ;_ end of strcat
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 14.02.2019, 07:22
#36
Зодчий1989


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


Цитата:
Сообщение от VVA Посмотреть сообщение
VVA
,
Цитата:
Сообщение от VVA Посмотреть сообщение
вместо vla-get-objectid использовать функцию Get-ObjectID-x86-x64
Идеально работает. Может пригодится кому нибудь.
Программа извлекает свойство (указывается в строке 61 ">%).Area \\f \"%lu2%pr2%ct8[1e-006]\">%}") из полилинии и вставляет в пространство листа "полем" ACADa.

Код:
[Выделить все]
  (defun c:farea (/ adoc ent pt *error*)
               ;|
*    Вставка полем с последовательным выбором полилиний "по одной"
|;
  (defun loc:unhighlight (ent)
    (vl-catch-all-apply
      '(lambda ()
         (if ent
           (vla-highlight
             (cond
               ((= (type ent) 'ename) (vlax-ename->vla-object ent))
               (t ent)
               ) ;_ end of cond
             :vlax-false
             ) ;_ end of vla-highlight
           ) ;_ end of if
         ) ;_ end of lambda
      ) ;_ end of vl-catch-all-apply
    ) ;_ end of defun

  (defun *error* (msg)
    (loc:unhighlight ent)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (while
    (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)))) "*LINE")
      (setq ent (vlax-ename->vla-object ent))
      ((lambda () (vla-highlight ent :vlax-true) t))
      (not (vl-catch-all-error-p
             (vl-catch-all-apply
               '(lambda ()
                  (setq pt (getpoint "\nТочка вставки результата <Отмена> : "))
                  ) ;_ end of lambda
               ) ;_ end of vl-catch-all-apply
             ) ;_ end of vl-catch-all-error-p
           ) ;_ end of not
      pt
      ) ;_ end of and
     (vla-startundomark adoc)
     (loc:unhighlight ent)
     (vla-addmtext
       (vla-objectidtoobject adoc (vla-get-ownerid ent))
       (vlax-3d-point pt)
       0
       (strcat "{\\L%<\\AcObjProp.16.2 Object(%<\\_ObjId "
               (vl-princ-to-string (get-objectid-x86-x64 ent))
               ">%).Area \\f \"%lu2%pr2%ct8[1e-006]\">%}"
               ) ;_ end of strcat
       ) ;_ end of vla-AddMText
     (vla-endundomark adoc)
     ) ;_ end of while
  (loc:unhighlight ent)
  (princ)
  ) ;_ end of defun
;;--------------------------------------------------------
;; Функция получает строковое представление ObjectID
;; вне зависимости от того AutoCAD x86 или x64
;; Источник: https://discussion.autodesk.com/forums/message.jspa?messageID=6172961
;;--------------------------------------------------------
(defun Get-ObjectID-x86-x64 (obj / util)
  (setq util (vla-get-Utility (vla-get-activedocument (vlax-get-acad-object))))
  (if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
  (if (= (type obj) 'VLA-OBJECT)
     (if (> (vl-string-search "x64" (getvar "platform")) 0)
       (vlax-invoke-method util "GetObjectIdString" obj :vlax-False)
       (rtos (vla-get-objectid obj) 2 0)
     )
  )
) ;_ end of defun
Зодчий1989 вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Добавление в чертеж длины полилинии

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

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