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

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

Как подписать длины всех выбранных отрезков

Ответ
Поиск в этой теме
Непрочитано 25.03.2016, 19:04
Как подписать длины всех выбранных отрезков
megabeton
 
Регистрация: 03.12.2009
Сообщений: 84

Есть лисп (во вложении), рисующий возле каждого отрезка (после выбора группы отрезков) текст с указанием его длины.
Однако хотелось бы его доработать, а именно:
- текст возле отрезка отрисовывается в текущем слое, а хотелось бы, что бы слой текста соответствовал слою отрезка;
- выравнивание отрисовываемого текста производилось "вниз по центру"
- добавить возможность работы с полилиниями и прочими примитивами (окружности, дуги и т.д.)
- добавить возможность установки поправочного коэффициента;
- добавить возможность установки необходимого округления/точности;
- добавить возможность установки высоты текста;
- ну и бонусом, сделать лисп со всем вышеперечисленным для возможности работы с площадями, т.е подписывать объекты, имеющие площадь

В принципе все вышеперечисленное умеет делать спецкалькулятор VetCAD, за одним исключением - он дает результат одним числом для всех выбранных отрезков/площадей, а нужна возможность подписать именно каждый примитив/площадь в группе за одно действие.

Прошу помощи знатоков лисп программирования!

Вложения
Тип файла: lsp длот.lsp (928 байт, 226 просмотров)

Просмотров: 14838
 
Непрочитано 20.02.2020, 09:17
#21
tr0ll


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


Цитата:
Сообщение от frostmourn Посмотреть сообщение
L (Kr_roundof (distance pt1 pt2) 1))
Что в коде изменить, чтобы округление было до сотых? Заранее спасибо!
tr0ll вне форума  
 
Автор темы   Непрочитано 15.10.2020, 12:55
#22
megabeton


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


(rtos L 2 2)
megabeton вне форума  
 
Непрочитано 01.03.2023, 14:36
#23
Мертвая наука


 
Регистрация: 19.10.2018
Москва
Сообщений: 246


Подниму тему. Было бы еще лучше если доделать лисп, чтобы он не текст выдавал, а поле. Естественно поле бы ссылалось на обьект и значение длины линии. Я не умею в код к сожалению...
__________________
Проектирование КЖ, КМ, КР, АС. Москва.
Мертвая наука вне форума  
 
Непрочитано 06.03.2023, 09:07
#24
VVA

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


Цитата:
Сообщение от Мертвая наука Посмотреть сообщение
чтобы он не текст выдавал, а поле
пробуй
Код:
[Выделить все]
(defun c:lalF (/ p1 p2 pt1 pt2 ent pr l fld en)
;_пишет длину всех выбранных отрезков полем
;_в строке ">%).Length \\f \"%lu2%pr2\">%"
;_ pr2 - 2 знака после запятой
;_ pr3 - 3 знака после запятой
;_https://forum.dwg.ru/showthread.php?t=130372  
(vl-load-com)
(if (setq ss (ssget '((0 . "LINE"))))
  (progn
    (setq index -1
	    lr 0)
    (repeat (sslength ss)
      (setq index (1+ index)
            en (ssname ss index)
	    pr (entget en)
	    pt1 (cdr (assoc 10 pr))
	    pt2 (cdr (assoc 11 pr))
	    L (Kr_roundof  (distance pt1 pt2) 1))
      (setq fld (strcat
                "%<\\AcObjProp Object(%<\\_ObjId "
                (vl-princ-to-string
                  (Get-ObjectID-x86-x64 (vlax-ename->vla-object en))
                  ) ;_ vl-princ-to-string
                ">%).Length \\f \"%lu2%pr2\">%"
                ) ;_ strcat
          )
;_ (vla-addText (vla-get-ModelSpace (vla-get-activedocument (vlax-get-acad-object))) (rtos L 2 0) (vlax-3D-point '(0. 0. 0.)) (getvar "textsize")) ;_rem VVA 2023-03-06
(vla-addText (vla-get-ModelSpace (vla-get-activedocument (vlax-get-acad-object))) fld (vlax-3D-point '(0. 0. 0.)) (getvar "textsize"))      
(if (< (angtof "90") (angle pt1 pt2) (angtof "270.01" )) (setq p1 pt2 p2 pt1) (setq p1 pt1 p2 pt2))      
(Kr-AligmentText (* 1 (Kr_ScaleOfVP)) "ang" 0 p1 p2 (vlax-ename->vla-object (entlast)))
(vla-put-Layer (vlax-ename->vla-object (entlast)) (cdr (assoc 8 pr)))
      );repeat
  );rogn
  );if
  );defun

;|Функция Kr_roundof
Округление числа с заданным множителем.
num - число для округления (вводить вещественное число)
presc - множитель

Примеры
(Kr_roundof 45985. 3) 45984.0 
(Kr_roundof -45.56 3) -45.0 
(Kr_roundof 459. 5) 460.0
(Kr_roundof 459 5) 455.0 
(Kr_roundof 4.3 1.2) 4.8
(Kr_roundof 0.1 1.2) 0.0
|;
(defun Kr_roundof (num presc / )
(* (atof (rtos (/ num presc) 2 0)) presc)
  )

;|
Функция Kr_AligmentTextLine
*** Автор Морозов С.В. aka Krieger ***
Выравнивает Mtext и Text относительно двух точек
Параметры
а - величина смещения текста над линией
An - угол в градусах или "ang" - угол по линии
Justify - выравнивание текста для Mtext/Text:
	0 - BottomCenter
	1 - MiddleCenter
	2 - TopCenter
Примеры:
(Kr_AligmentTextLine (* 2 (Kr_ScaleOfVP)) "ang" 0) ;над линией
(Kr_AligmentTextLine 0 0 1) ;просто в центр
(Kr_AligmentTextLine (* -2 (Kr_ScaleOfVP)) "ang" 2) ;под линию
(Kr_AligmentTextLine 0 30 1) ;в центр, с фиксированным углом 30 градусов
|;

(defun Kr-AligmentText (a An Justify p1 p2 vl-ent / UL UL2 pt2 An2)
	    	(setq 	UL1 (angle P1 P2)
			p1 (trans p1 1 0)
			p2 (trans p2 1 0)
			UL2 (angle P1 P2)
			pt2 (polar (polar P1 (angle P1 P2) (/ (distance P1 P2) 2))
				   (+ (* (/ 90.0 180.0) pi)
				      (angle p1 p2))
				   a))
	      
		(cond
		  ((eq (vla-get-ObjectName vl-ent) "AcDbMText");если Mtext
			(cond
			  ((= Justify 0) (vla-put-AttachmentPoint  vl-ent acAttachmentPointBottomCenter))
			  ((= Justify 1) (vla-put-AttachmentPoint  vl-ent acAttachmentPointMiddleCenter))
			  ((= Justify 2) (vla-put-AttachmentPoint  vl-ent acAttachmentPointTopCenter))
			  )
		   
		(if (or (eq (type An) 'INT)
			(eq (type An) 'REAL))
		  (setq An2 (* (/ An 180.0) pi))
		  (setq An2 UL1))
		   
		   (vla-put-InsertionPoint vl-ent (vlax-3D-point pt2))
		   (vla-put-Rotation vl-ent An2)
		   );cond
		  ((eq (vla-get-ObjectName vl-ent) "AcDbText");если Text
			(cond
			  ((= Justify 0) (vla-put-Alignment vl-ent acAlignmentBottomCenter))
			  ((= Justify 1) (vla-put-Alignment vl-ent acAlignmentMiddleCenter))
			  ((= Justify 2) (vla-put-Alignment vl-ent acAlignmentTopCenter))
			  )
		   
		(if (or (eq (type An) 'INT)
			(eq (type An) 'REAL))
		  (setq An2 (+ (* (/ An 180.0) pi) (- UL2 UL1)))
		  (setq An2 UL2))
		   
		   (vla-put-TextAlignmentPoint vl-ent (vlax-3D-point pt2))
		   (vla-put-Rotation vl-ent An2)
		   );
		  );cond
  );defun



;|---------------------------------------------------------------
Функция Kr_ScaleOfVP
-----------------------------------------------------------------
Вычисляет масштаб в зависимоти от переменной dimscale или CANNOSCALEVALUE, если dimscale=0 коэф-т = 1 или относительно vport
|;
(defun Kr_ScaleOfVP ( / )
  ;если текущим установлен аннотативный размерный стиль, масштаб берем с аннотативного масштаба
  (if (= (getvar "dimanno") 1)
    (setq dsc (/ 1 (getvar "CANNOSCALEVALUE")))
    (progn
  ;если dimscale=0 принимаем dsc=1, если нет dsc=dimscale
  			(if (= (getvar "dimscale") 0) (setq dsc 1) (setq dsc (getvar "dimscale")))
  ;если мы находимся в пространстве листа:
			(if (= (Getvar "TILEMODE") 0)
  ;если видовое окно не ативно dsc=1, если активно, то берем масштаб с видового экрана
			  (if (= (Getvar "CVPORT") 1)
			    (setq dsc 1)
			    (setq dsc (/ 1 (vla-get-CustomScale (vla-get-ActivePViewport (vla-get-ActiveDocument (vlax-get-Acad-Object))))))
			  );if
			 );if
      );progn
    );if
    dsc
    )
;;--------------------------------------------------------
;; Функция получает строковое представление ObjectID
;; вне зависимости от того AutoCAD x86 или x64
;; Источник: "Field and objectid problem"
;;http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/Field-and-objectid-problem/m-p/2478592/highlight/true#M276818
;; http://forum.dwg.ru/showthread.php?t=51822
;; https://autolisp.ru/2011/07/07/x32x64objectid/
;;--------------------------------------------------------
(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)
     )
  )
)
pr2 - 2 знака после запятой
pr3 - 3 знака после запятой

Еще похожая тема Добавление в чертеж длины полилинии
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Как подписать длины всех выбранных отрезков

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Разработка ПОС, искусство проектирования Tyhig Технология и организация строительства 117 25.11.2021 17:38
Общая длина всех отрезков. SanchouZ AutoCAD 33 25.07.2016 11:49
Экспорт в Excel длины всех участков полилинии Meddoks Программирование 22 09.09.2013 22:52
Инструмент определения общей длины всех выделенных линий лежащих в разных плоскостях в AUTOCAD 2006 Геннадий+ AutoCAD 3 01.10.2009 18:33
Определение суммарной длины отрезков Александр Шевелев Программирование 1 16.12.2007 23:10