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

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

LISP. Простановка площадей внутри полилинии.

Ответ
Поиск в этой теме
Непрочитано 21.07.2008, 13:56
LISP. Простановка площадей внутри полилинии.
Klo
 
Инженер-конструктор
 
Юбилейный МО
Регистрация: 29.10.2007
Сообщений: 266

Для облегчения и ускорения монотонной работы я сварганил лиспик, который после клика по замкнутой полилинии проставляет внутри нее по центру площадь и название помещения ("офис" по умолчанию).
Код:
[Выделить все]
(defun c:mark ()
(vl-load-com)
(setq pl1 (car (entsel "Choose closed polyline:")))
(setq pl1_vla (vlax-ename->vla-object pl1))
(setq pl1_area (vla-get-Area pl1_vla))
(setq pl1_ar (rtos (/ pl1_area 1000000) 2 2))
(setq lable (strcat "Офис" "\n" pl1_ar " м" "\U+00B2"))

(setq pl1_dxf (entget (entlast)))
  
(setq x_all (list 0))
(setq n 0)
(setq group nil)
(while (/= group 210)
       (setq n (+ n 1))
       (setq group (car (nth n pl1_dxf)))
             (if (= group 10) (setq xi (list (car (cdr (nth n pl1_dxf))))) (setq xi nil));end of if
       (setq x_all (append x_all xi))
); end of while
(setq x_all (cdr x_all))
  
(setq y_all (list 0))
(setq n 0)
(setq group nil)
(while (/= group 210)
       (setq n (+ n 1))
       (setq group (car (nth n pl1_dxf)))
             (if (= group 10) (setq yi (list (car (cdr (cdr (nth n pl1_dxf)))))) (setq yi nil));end of if
       (setq y_all (append y_all yi))
); end of while
(setq y_all (cdr y_all))

(setq x_min (apply 'min x_all) x_max (apply 'max x_all) y_min (apply 'min y_all) y_max (apply 'max y_all))
(setq pt1 (list x_min y_max) pt2 (list x_max y_min))
  
(command "_mtext" pt1 "h" 250 "j" "mc" pt2 lable "")
  
); end of defun


Есть маленькая проблема: как задать высоту "ручек" текста (синенькие такие)? Нужно чтоб высота "ручек" равнялась высоте прямоугольника (если полилиния прямоугольная), p.s: в лиспе самая верхняя и нижняя координаты определены (y_max и y_min).
Просмотров: 9636
 
Непрочитано 13.12.2018, 14:37
#21
tsetse

Инженер-конструктор
 
Регистрация: 25.12.2015
Москва
Сообщений: 77


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Я был вынужден переписать Get-ObjectID-x86-x64
Я так понимаю, это улучшенная версия? Get-ObjectID-x86-x64 имел только один входной параметр obj. Тут же появился второй аргумент id. Но его же мы и хотим узнать? В общем постараюсь разобраться.
Если можно вопрос. Как к этой конструкции
Код:
[Выделить все]
 (ssget "_+.:E:S" '((0 . "lwpolyline")))
Прицепить дополнительно
Код:
[Выделить все]
 '((0 . "CIRCLE"))
tsetse вне форума  
 
Непрочитано 13.12.2018, 14:45
1 | 1 #22
Сергей812


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


(0 . "lwpolyline,CIRCLE")
Сергей812 вне форума  
 
Непрочитано 13.12.2018, 16:45
1 | #23
tsetse

Инженер-конструктор
 
Регистрация: 25.12.2015
Москва
Сообщений: 77


Немного модифицировал. Добавил проверки ошибок. Окружности теперь тоже считает. Get-ObjectID-x86-x64 пока что прошлых версий
Код:
[Выделить все]
 (defun c:putarea (/ *error* thetext text txth curtxt mspace objtype #closed objsel cur_pl)
(vl-load-com)
(setq txth 250)
(setq curtxt (getvar 'TEXTSTYLE))
(setq mspace
	(vla-get-modelspace 
		(vla-get-activedocument 
			(vlax-get-acad-object)
		)
	)
)
(while
	; в случае ошибки выводим сообщение об отмене
	(defun *error*(msg) 
 	(princ "Команда отменена")
 	) 	
	; выбираем полилинию либо окружность
	(progn
		(setq objsel (ssget "_+.:E:S" '((0 . "lwpolyline,CIRCLE"))))
		(if (/= objsel nil)
			(setq cur_pl (ssname objsel 0))
			(setq cur_pl "Эх")
		) ;end if
	) ; end progn
	(if (/= cur_pl "Эх") ; проверяем, есть ли что то подходящее в cur_pl
		(progn
			; определяем тип выбранного объекта
			(setq objtype (cdr (assoc 0 (entget cur_pl))))
			; находим objectid объекта
			(setq idd ( Get-ObjectID-x86-x64 cur_pl))
			; создаем код поля
			(setq text
				(strcat "%<" (chr 92) "AcObjProp.16.2 Object(%<" (chr 92) "_ObjId" " " idd ">%).Area" " " (chr 92) "f" " " "%lu2%pr2%ct8[1.000000000000000E-006]" ">%")
			) ; end seq
			; дописываем доп ифно
			(setq text
				(strcat "Офис" " " text "м" "\U+00B2")
			) ;end seq
			; проверяем полилинию на замкнутость
			(if (= objtype "LWPOLYLINE")
				(setq #closed
					(vlax-get-property (vlax-ename->vla-object cur_pl) 'closed)
				) ;end seq в случае true
				(setq #closed :vlax-true) ; в случае false 
			) ;end if
			; запрашиваем точку для размещения текста
			(setq pt (getpoint "\n Где разместим текст?:"))
			; вписываем сгенерированный текст и вставляем объект
			(setq thetext (vla-AddText mspace text 
				(vlax-3d-point pt) txth)
			)
			; устанавливаем текстовый стиль
			(vlax-put-property thetext 'StyleName  curtxt)
			; Если выбрана полилиния и она не замкнута делаем цвет красным
			(if (= #closed :vlax-false)
				(vla-put-Color thetext acred)
			) ; end if
		) ; end progn ; Если подходящее в cur_pl есть
	(prin1 "Так не пойдёт! Выбери что-то другое!") ; Если подходящего в cur_pl нет
	) ;end if
) ; end while
) ; end defun

; Ниже приведены вспомогательные функции
;________________________________________________________________________________

; Функция получения objectID
; Источник: 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)
		)
	)
)

tsetse вне форума  
 
Непрочитано 14.12.2018, 16:52
#24
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,665


Цитата:
Сообщение от tsetse Посмотреть сообщение
; проверяем полилинию на замкнутость
это вовсе не обязательно. технически свойства площади для полилинии разомкнутой и замкнутой идентичны и считаются так, как если бы полилиния была замкнута.
koMon вне форума  
 
Непрочитано 14.12.2018, 16:56
#25
Кулик Алексей aka kpblc
Moderator

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


Цитата:
Сообщение от koMon Посмотреть сообщение
технически свойства площади для полилинии разомкнутой и замкнутой идентичны
По-моему, может иметь значение, дуговой последний сегмент или нет.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 14.12.2018, 17:06
#26
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,665


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
По-моему, может иметь значение, дуговой последний сегмент или нет.
да, имеет. но и замыкание такой полилинии приведёт к непредсказуемому результату с точки зрения площади.
koMon вне форума  
 
Непрочитано 14.12.2018, 17:43
#27
tsetse

Инженер-конструктор
 
Регистрация: 25.12.2015
Москва
Сообщений: 77


Цитата:
Сообщение от koMon Посмотреть сообщение
это вовсе не обязательно. технически свойства площади для полилинии разомкнутой и замкнутой идентичны и считаются так, как если бы полилиния была замкнута.
Эта проверка, чтобы сделать текст красным для незамкнутой)
tsetse вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > LISP. Простановка площадей внутри полилинии.

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
lisp: Длина по полилинии до точки vosh LISP 19 15.07.2013 15:10
загрузка DOS прог через LISP Gaa LISP 15 12.08.2005 19:19