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

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

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

Ответ
Поиск в этой теме
Непрочитано 21.07.2008, 13:56 #1
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).
Просмотров: 9635
 
Непрочитано 21.07.2008, 14:53
#2
Кулик Алексей aka kpblc
Moderator

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


А _.field не пробовал использовать?
Почему все переменные глобальные?
Где контроль передаваемых значений? Правильности выбора?
"Ручки" (точнее, их размер) регулируется системной переменной APERTURE.
То же, без применения команд:
Код:
[Выделить все]
(defun c:new-mark-text (/ *error* ent prefix minp maxp res)
  (defun *error* (msg)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (if
    (and
      (= (type
           (vl-catch-all-apply
             '(lambda ()
                (setq ent (car (entsel "\nSelect colsed polyline <Cancel> : ")))
                ) ;_ end of lambda
             ) ;_ end of vl-catch-all-apply
           ) ;_ end of type
         'ename
         ) ;_ end of =
      (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
      (equal (vla-get-closed (vlax-ename->vla-object ent)) :vlax-true)
      (= (type (setq prefix
                      (vl-catch-all-apply
                        (function
                          (lambda (/ res)
                            (if (or (not *prefix*) (= (vl-string-trim " " *prefix*) ""))
                              (setq *prefix* "Офис")
                              ) ;_ end of if
                            (setq
                              res
                               (cond
                                 ((getstring t (strcat "\nPrefix <" *prefix* " > : ")))
                                 (t *prefix*)
                                 ) ;_ end of cond
                              ) ;_ end of setq
                            (if (= res "")
                              (setq res *prefix*)
                              ) ;_ end of if
                            (vl-string-trim " " res)
                            ) ;_ end of lambda
                          ) ;_ end of function
                        ) ;_ end of vl-catch-all-apply
                     ) ;_ end of setq
               ) ;_ end of type
         'str
         ) ;_ end of =
      ) ;_ end of and
     (progn
       (setq *prefix* prefix)
       (vla-getboundingbox (vlax-ename->vla-object ent) 'minp 'maxp)
       (setq minp   (vlax-safearray->list minp)
             maxp   (vlax-safearray->list maxp)
             center (mapcar '(lambda (a b) (* (+ a b) 0.5)) minp maxp)
             ) ;_ end of setq
          ; (42 . 1679.17) (43 . 700.5) (50 . 0.0) (73 . 1) (44 . 1.0))
       res
       (entmakex
         (list
           (cons 0 "MTEXT")
           '(100 . "AcDbEntity")
           '(100 . "AcDbMText")
           (cons 10 center)
           (cons 40 250.)
           (cons 71 5)
           '(72 . 5)
           (cons 1
                 (strcat
                   *prefix*
                   "\\P"
                   (rtos (* (vla-get-area (vlax-ename->vla-object ent)) 1e-6) 2 2)
                   "м2"
                   ) ;_ end of strcat
                 ) ;_ end of cons
           (assoc 210 (entget ent))
           '(50 . 0.)
           '(42 . 0.)
           '(73 . 1)
           '(44 . 1)
           ) ;_ end of list
         ) ;_ end of entmakex
       ) ;_ end of progn
     ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun
Поскольку непонятна версия AutoCAD'a, вариант для поля не пишу.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 21.07.2008, 15:11
#3
VVA

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


А так же
http://dwg.ru/f/showthread.php?t=18852
http://dwg.ru/dnl/184
http://dwg.ru/f/showthread.php?t=14528
http://dwg.ru/f/showthread.php?t=13524
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 21.07.2008, 15:15
#4
Кулик Алексей aka kpblc
Moderator

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


VVA, эт точно
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 21.07.2008, 15:19
#5
Klo

Инженер-конструктор
 
Регистрация: 29.10.2007
Юбилейный МО
Сообщений: 266


Большое спасибо, буду пробовать эту переменную.
Насчет контроля значений, это пока выше моих способностей...
В исправленном LISP'е мне дня три разбираться (на работе никак не выйдет).
Thx.
Klo вне форума  
 
Непрочитано 05.12.2018, 20:22
#6
megabeton


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


Пытаюсь зациклить программу из поста № 2 на множественный выбор полилиний с последующей пробивкой площади в каждой полилинии. Но никак не получается. Подскажите где ошибка

Код:
[Выделить все]
(defun c:new-mark-text26 (/ *error* ent minp maxp index ss center)
  (defun *error* (msg)
        (vla-endundomark adoc)
        (princ msg)
        (princ)
     ) ;_ end of defun
  (vl-load-com)
  (vla-startundomark
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
     ) ;_ end of vla-startundomark
  (if
    (setq ss (ssget '((0 . "LWPOLYLINE"))))
    (progn
      (setq index -1) 
      (repeat (sslength ss)
        (setq index (1+ index))
	        ent (ssname ss index));end of repeat
      (vla-getboundingbox (vlax-ename->vla-object ent) 'minp 'maxp)
      (setq minp (vlax-safearray->list minp)
            maxp (vlax-safearray->list maxp)
          center (mapcar '(lambda (a b) (* (+ a b) 0.5)) minp maxp));end of setq
      (repeat (sslength ss)
        (entmakex 
          (list 
             (cons 0 "MTEXT") 
            '(100 . "AcDbEntity") 
            '(100 . "AcDbMText") 
             (cons 10 center) 
             (cons 40 250.) 
             (cons 71 5) 
            '(72 . 5) 
             (cons 1 
                (strcat  (rtos (* (vla-get-area (vlax-ename->vla-object ent)) 1e-6) 2 3) "");end of strcat
                  );end of cons
             (assoc 210 (entget ent))
	     '(50 . 0.)
            '(42 . 0.)
            '(73 . 1)
            '(44 . 1)
           );end of list
         );end of entmakex
       );end of repeat
     );end of progn
   );end of if
(vla-endundomark adoc)
(princ)
);end of defun
megabeton вне форума  
 
Непрочитано 06.12.2018, 00:40
1 | #7
ciril

САПР
 
Регистрация: 29.09.2011
СПб
Сообщений: 283


В коде ошибка, у тебя два последовательных repeat по длине набора.
Код:
[Выделить все]
 (defun c:new-mark-text26 (/ *error* ent minp maxp index ss center)
  (defun *error* (msg)
        (vla-endundomark adoc)
        (princ msg)
        (princ)
     ) ;_ end of defun
  (vl-load-com)
  (vla-startundomark
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
     ) ;_ end of vla-startundomark
  (if
    (setq ss (ssget '((0 . "LWPOLYLINE"))))
    (progn
      (setq index -1) 
      (repeat (sslength ss)
        (setq index (1+ index))
	          ent (ssname ss index))
        (vla-getboundingbox (vlax-ename->vla-object ent) 'minp 'maxp)
        (setq minp (vlax-safearray->list minp)
            maxp (vlax-safearray->list maxp)
          center (mapcar '(lambda (a b) (* (+ a b) 0.5)) minp maxp));end of setq
        (entmakex 
          (list 
             (cons 0 "MTEXT") 
            '(100 . "AcDbEntity") 
            '(100 . "AcDbMText") 
             (cons 10 center) 
             (cons 40 250.) 
             (cons 71 5) 
            '(72 . 5) 
             (cons 1 
                (strcat  (rtos (* (vla-get-area (vlax-ename->vla-object ent)) 1e-6) 2 3) "");end of strcat
                  );end of cons
             (assoc 210 (entget ent))
	     '(50 . 0.)
            '(42 . 0.)
            '(73 . 1)
            '(44 . 1)
           );end of list
         );end of entmakex
       );end of repeat
     );end of progn
   );end of if
(vla-endundomark adoc)
(princ)
);end of defun  
На телефоне не поверить.
__________________
На работе было скучно:shout:
ciril вне форума  
 
Непрочитано 06.12.2018, 10:34
#8
megabeton


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


ciril, там к сожалению не только в repeat'е дело. Пока ругается на неверный тип аргумента "неверный тип аргумента: lentityp nil".
Такое ощущение, что я из набора неправильно примитивы извлекаю.
Если пользоваться кодом Кулик Алексей aka kpblc с одиночным выбором (car(entsel)), то center находит и entmakex выполняет.
А вот с массовкой проблемы.
В одной из вариаций она у меня отбивала несколько текстов (площадь первой из набора полилинии) в одну полилинию, игнорируя другие.
megabeton вне форума  
 
Непрочитано 06.12.2018, 11:22
1 | #9
P_S


 
Регистрация: 09.10.2006
Санкт-Петербург
Сообщений: 99


minp и maxp имеют тип variant. Соответственно, получение списка:
Код:
[Выделить все]
 (setq minp (vlax-safearray->list(vlax-variant-value minp)))
и т.д.
P_S вне форума  
 
Непрочитано 06.12.2018, 12:57
#10
megabeton


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


Да что ж такое, все же просто, но не работает (

Код:
[Выделить все]
 Если if (взят набор элементов ssget) выполни программу progn
    возьми index = -1
    повтори repeat (столько раз, сколько элементов в наборе) следующие действия:
         возьми index = i (1+ index)
         возьми имя i-го элемента
         выдай "центр тяжести" ((vla-getboundingbox)) i-го элемента
         создай текст в "центре тяжести" ((cons 10 center)) i-го элемента
На выходе : "неверный тип аргумента: lentityp nil"

На вариант ругается : "ошибка: неверный тип аргумента: variantp #<safearray...>"


Дополнено:
Виноват, дело было в репите, слишком рано скобку закрывал, починил.

Последний раз редактировалось megabeton, 06.12.2018 в 15:33.
megabeton вне форума  
 
Непрочитано 07.12.2018, 10:00
1 | #11
ciril

САПР
 
Регистрация: 29.09.2011
СПб
Сообщений: 283


Код:
[Выделить все]
 (defun c:new-mark-text26  (/ *error* ent minp maxp index ss center)
  (defun *error* (msg) (vla-endundomark adoc) (princ msg) (princ)) ;_ end of defun
  (vl-load-com)
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object)))) ;_ end of vla-startundomark
  (while (setq ss (ssget '((0 . "LWPOLYLINE"))))
    (repeat (setq index (sslength ss))
      (vla-getboundingbox
        (vlax-ename->vla-object (setq ent (ssname ss (setq index (1- index)))))
        'minp
        'maxp)
      (entmakex
        (list '(0 . "MTEXT")
              '(100 . "AcDbEntity")
              '(100 . "AcDbMText")
              (cons 10
                    (mapcar '(lambda (a b) (* (+ a b) 0.5)) (vlax-safearray->list minp) (vlax-safearray->list maxp)))
              (cons 40 250.)
              (cons 71 5)
              '(72 . 5)
              (cons 1
                    (strcat (rtos (* (vla-get-area (vlax-ename->vla-object ent)) 1e-6) 2 3) "") ;end of strcat
                    )                   ;end of cons
              (assoc 210 (entget ent))
              '(50 . 0.)
              '(42 . 0.)
              '(73 . 1)
              '(44 . 1))                ;end of list
        )                               ;end of entmakex
      )                                 ;end of repeat
    )                                   ;end of if
  (vla-endundomark adoc)
  (princ))                              ;end of defun  
Изменил на цикл, пока выбираются примитивы.
__________________
На работе было скучно:shout:
ciril вне форума  
 
Непрочитано 12.12.2018, 16:32
#12
megabeton


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


Такой вопрос.
Если центр тяжести полилинии лежит за пределами контура полилинии (Г-образный контур к примеру), то площадь соответственно отбивается за пределами контура.
Посоветуйте, хотя бы на уровне идеи, как принудить текст к смещению в пределы контура?

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

Ну и может кто предложит более простые решения.
megabeton вне форума  
 
Непрочитано 12.12.2018, 16:50
1 | #13
Кулик Алексей aka kpblc
Moderator

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


Проверяешь, входит ли точка внутрь контура. Если нет - находишь, к примеру, самую ближайшую точку (или вершину), вычисляешь смещение внутрь и ставишь текст.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 13.12.2018, 10:15
1 | #14
ciril

САПР
 
Регистрация: 29.09.2011
СПб
Сообщений: 283


Ну или
1. считаешь центроид для контура,
2. если центроид не входит в контур, удаляешь самую дальнюю от центроида вершину контура,
3. снова 1
__________________
На работе было скучно:shout:
ciril вне форума  
 
Непрочитано 13.12.2018, 11:31
#15
Сергей812


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


Вариант 3:
1. Проверять, находиться ли точка внутри контура. Если нет - запоминать в отдельном списке и пропускать контур.
2. По завершении автоматической расстановки надписей программа сообщает, что не удалось поставить n - надписей, и начинает по списку позиционировать чертеж на контурах из отдельного списка и предлагать пользователю указать месторасположение надписи. Не знаю, есть ли в лиспе возможность "повесить" текст на курсор, чтобы было проще размещать.
Сергей812 вне форума  
 
Непрочитано 13.12.2018, 11:38
#16
Alex.gomel


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


https://forums.autodesk.com/t5/forge...p/7685147#M743
Alex.gomel вне форума  
 
Непрочитано 13.12.2018, 13:10
#17
tsetse

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


Работает в цикле. После выбора полилинии предлагает выбрать точку, куда поместить текст. Площадь вставляет как текст полем. Если полилиния не замкнута, назначает тексту красный цвет. К сожалению, не знаю, как на entsel прицепить фильтр выбора(((
Код:
[Выделить все]
 
(defun c:putarea ( / thetext text txth curtxt mspace #closed)
(vl-load-com)
(setq cur_pl nil)
(setq txth 250)
(setq curtxt (getvar 'TEXTSTYLE))
(setq mspace
	(vla-get-modelspace 
		(vla-get-activedocument 
			(vlax-get-acad-object)
		)
	)
)
(while
		; выбираем полилинию
		(setq cur_pl
				(ssname
					(ssget "_+.:E:S" '((0 . "lwpolyline")))
				0)
		)
		; находим ее 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")
		)
		(setq #closed
			(vlax-get-property (vlax-ename->vla-object cur_pl) 'closed)
		)
		(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 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, 13.12.2018 в 14:15.
tsetse вне форума  
 
Непрочитано 13.12.2018, 13:18
#18
Кулик Алексей aka kpblc
Moderator

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


На entsel - никак. Но можешь для ssget использовать конструкцию типа (пишу без ACAD'a, так что последовательность "_", "." и "+" проверяй самостоятельно:
(ssget "_.+:S:E" '((0 . "lwpolyline")))
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 13.12.2018, 13:59
#19
tsetse

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


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
На entsel - никак. Но можешь для ssget использовать конструкцию типа (пишу без ACAD'a, так что последовательность "_", "." и "+" проверяй самостоятельно:
(ssget "_.+:S:E" '((0 . "lwpolyline")))
Верно так
Код:
[Выделить все]
 (ssget "_+.:E:S")
К сожалению, при переходе на ssget цикл завершается после первой проходки и размещения текста. При использовании entsel было так: выбираем полилинию - выбираем куда разместить, затем снова запрос на выбор полилинии и размещения и т.д. Возможно дело в while. Какой цикл можете предложить использовать, чтобы после первой проходки тела программы, она запускалась снова?
Убрал progn все заработало)

Последний раз редактировалось tsetse, 13.12.2018 в 14:05.
tsetse вне форума  
 
Непрочитано 13.12.2018, 14:22
1 | #20
Кулик Алексей aka kpblc
Moderator

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


Ну вот, а я уже за код сел

----- добавлено через ~3 мин. -----
Тольк пару замечаний, можно?
Если пользователь нажмет Esc в момент запроса, мы получим ошибку. Не есть совсем гуд
И второе. Я был вынужден переписать Get-ObjectID-x86-x64 - в каких-то версиях (64-битных) срабатывал vla-objectidtoobject32, в каких-то - vla-objectidtoobject. Поэтому использую конструкцию типа:
Код:
[Выделить все]
 (defun _kpblc-objectidtoobject (obj id) ;|
*    получение объекта по его ID
*    параметры вызова:
  obj    указатель на объект документа
  id    значение ID получаемого объекта
|;
  (if (and (> (vl-string-search "x64" (getvar "platform")) 0)
           (vlax-method-applicable-p obj 'objectidtoobject32)
           ) ;_ end of and
    (vla-objectidtoobject32 obj id)
    (vla-objectidtoobject obj id)
    ) ;_ end of if
  ) ;_ end of defun
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > LISP. Простановка площадей внутри полилинии.

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

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


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