[Dima]

народ а вот такой вопросик:
можно ли к BOUNDARY прицепить каойнибудь LISP чтоб он в нижнем правом или левом или верхнем... углу этого региона вписывал полученную площадь в м2 (ну примерно как в архикаде?

[Startrek]

POSMOTRI NA MOEI STRANICHKE HTTP://HOME.PACIFIER.COM/~NEMI
# 39
BLIZKO K TVOEMU VOPROSU - ARE LABEL

[{Smirnoff}]

Ну вот, я тут кое что написал. Не стал "прикручивать" к BOUNDARY, он вставлает площадь, в любые замкнутые примитивы и в т. ч. в BOUNDARY. Сначала вводиться масштаб (надеюсь понятно почему), потом надо щелкать по замкнутым объектам. После каждого щелчка, на кончике курсора появляеться текст с площадью, который можно вставить в удобное место. Текущий масштаб, сохраняеться весь сеанс работы, он указан в треугольных скобках и его можно пропустить нажатием [Enter]. Выход по [Esc]. Если что не устраивает, поправим. Имейте ввиду, что я сильно долго, этот ЛИСП не тестировал (ну минут 15).

Код:

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

(defun c:are (/ temp_scal obj obj_area selection)
  (setvar "cmdecho" 0)
  (vl-load-com)
  (if (not scal)(setq scal 1))
  (setq temp_scal scal)
  (setq scal(getreal (strcat "Enter scale <1:"(rtos scal 2 1)"> ")))
  (if (= scal nil)(setq scal temp_scal))
  (while T
    (princ "Next closed object or [Esc] to Quit ")
    (setq selection(car(entsel)))
    (if (/= selection nil)
      (progn
	 (setq obj (vlax-ename->vla-object selection))
	       (if (= T (vlax-property-available-p obj "Area"))
		 (progn
	       (setq obj_area (rtos(*(vla-get-area obj)scal)2 2))
(command "_.text" "0,0" (getvar "textsize") "0" obj_area "_.copybase" "0,0"
(entlast)"" "_.erase" (entlast)"" "_.pasteclip" pause)
		 );end progn
(alert "Object is not closed!\nSelect other object or press [Esc] to Quit.")
	       );end if
	);end progn
      (alert "Object is not selected!")
      );end if
    );end while
	 (princ)
	);end are

[Dima]

народ а так чтоб в ставлялав м да еще и стаила 2, так возможно сделать или это уже труднее? :roll:

[{Smirnoff}]

С Mx2.

Код:

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

(defun c:are (/ temp_scal obj obj_area selection) 
  (setvar "cmdecho" 0) 
  (vl-load-com) 
  (if (not scal)(setq scal 1)) 
  (setq temp_scal scal) 
  (setq scal(getreal (strcat "Enter scale <1:"(rtos scal 2 1)"> "))) 
  (if (= scal nil)(setq scal temp_scal)) 
  (while T 
    (princ "Next closed object or [Esc] to Quit ") 
    (setq selection(car(entsel))) 
    (if (/= selection nil) 
      (progn 
    (setq obj (vlax-ename->vla-object selection)) 
          (if (= T (vlax-property-available-p obj "Area")) 
       (progn 
          (setq obj_area (rtos(*(vla-get-area obj)scal)2 2)) 
(command "_.text" "0,0" (getvar "textsize") "0" 
(strcat obj_area " Mx2") "_.copybase" "0,0" 
(entlast)"" "_.erase" (entlast)"" "_.pasteclip" pause) 
       );end progn 
(alert "Object is not closed!\nSelect other object or press [Esc] to Quit.") 
          );end if 
   );end progn 
      (alert "Object is not selected!") 
      );end if 
    );end while 
    (princ) 
   );end are

Можешь найти строку (strcat obj_area " Mx2") "_.copybase" "0,0" и вставь вместо " Mx2" все что пожелаешь. Как сделать "m2" с надстрочной двойкой к сожалению, не знаю. Может есть что нибудь через %%? Можно и BOUNDARY, сначала прицепить, но невижу смысла, потеряеться универсальность.

[{Smirnoff}]

Хотя если, очень хочеться эту надпись, можно сделать в виде блока с атрибутами, тогда и надстрочную 2 можно.

[{Smirnoff}]

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

[Dima]

а как сделать так чтоб это число проставлялось в метрах а не в милиметрах и заданной высоты (а то я не могу найти в коде) хотя я не спец в лиспе!
достал? :wink:

[{Smirnoff}]

Ну, для того чтобы все соответствовало, сначала запрашиваеться масштаб. Если нужно чтобы масштаб по умолчанию, всегда был 0.001, найдите строку (if (not scal)(setq scal 1)) и поменяйте 1 на 0.001. Пардон, это я не додумал, потом конечно сделаю чтобы была 1000. Убирать, масштаб вообще, не вижу смысла. Ведь не все у нас например получаю от 1 архитектурной фирмы, чертежи строго 1:100 и такие же им должен возвращать, со своими сетями.

Высота текста текущая или если не установлена, то по умолчанию, содержиться в системной переменной TEXTSIZE. Если есть надобность, то можно сделать чтобы для расстановки этих лейблов, параметры текста были иными (высота, ширина, цвет и т. д.), они будут включаться только при работе программы и сохраняться на весь сеанс работы с чертежом. Подумайте, как вы хотите, время есть до вечера, потому что уезжаю я.

[Dima]

подождите масштаб 1:100 это у вас значит что если у вас расстояние 6м тов каде реально рисуете 6см? или это имеется ввиду вывод на печать?
я лично рисую 1:1 а масштаб задаю в пространстве листа!

[Grinzaid]

Дмитрий, что Вы вцепились в душу? Есть ведь вопрос поважнее:

Как измерять прощади не только замкнумых полилиний, но и просто ограниченного пространства, указывая внутреннюю точку. Т.е. чтоб команда работала как HATCH или BPOLY, а ещё лучше, чтобы вызывалось окно, подобное HATCH или BPOLY для возможности выбора метода селекции и вообще для общей унификации и "индовзапрелости озимых"

Пишу и сам дивлюсь собственной наглости :roll:

[{Smirnoff}]

Забежал тут домой с объекта, читаю, жду когда жрачка согреется.

>Dima. Вы Дима, безусловно чертите правильно. Но есть "товарищи", которые, нам совсем не товарищи, которые чертят в масштабе. А в определенных случаях, например в геодезических чертежах, чертят именно в метрах. И масштаб, я считаю, все таки надо оставить. Выставим его по умолчанию 1000 и будем пропускать нажатием [Enter]. Вы кстати не сказали мне ничего по поводу текста. Надо ли вводить какие либо настройки. Можно сделать так. В начале программы будет вылезать Scale<1:1000>/Height<250.0>/Width<1.0>/Color<By Layer> or [Enter] to Continue. В треугольных скобках, наиболее удобные зачения по умолчанию, которые можно поменять или перейти к "маркировке" нажатием [Enter]. Или это лишние навороты?

>Grinzaid А как насчет BOUNDARY, она ведь именно так и работает. Можно создать BOUNDARY, померять площадь, BOUNDARY "убить" (если не нужна). Думаю что тело функции меряющей площадь надо оформить в одну программу, запрос масштаба (и возможно других параметров) в другую, а создание BOUNDARY и его удаление в третью. И сделать так: ЗАПРОСИТЬ ПАРАМЕТРЫ ЛЕЙБЛА (1 раз)>ВЫЗВАТЬ "BOUNDARY" CО ВСЕМИ СОПУТСТВУЮЩИМИ ПАРАМЕТРАМИ (наиболее предпочтительные параметры по умолчанию, изменить их или продолжить Enter) > ИЗМЕРИТЬ ПЛОЩАДЬ И ВСТАВИТЬ ЛЕЙБЛ> УДАЛИТЬ "BOUNDARY" (ЕСЛИ НУЖНО) >ВЕРНУТЬСЯ К ПАРАМЕТРАМ "BOUNDARY". Таким образом мы получим две функции, одна попроще и быстрее, другую мение помедленней но более функциональную.

Я конечно, мало соображаю в архитектурном деле, только чертежи ваши своими системами безопасности засоряю. Программирую из "любви к исскуству", так уж подскажите если что не так.

Вы Влад, по моему сами неплохо программируете. Бывал я в вашем Тель-Авиве, в командировке на 10 дней, жил в маленькой гостинице напротив отеля "Opera". Понял что хлебушек в Израиле очень тяжело достаеться... А еще кредитами всякими, "на иглу" конкретно сажают. Наверное чтобы в Штаты не сбежали?

Однако остыло все...

[Apelsinov]

Могу предложить на суд свою прогу, именно с BOUNDARY, текст с значением площади она не вставляет, ну да это не трудно сделать. Выдает сообщение со значением площади и периметра в единицах акада и в метрах при масштабе 1:1, т.е. в 1 ед.=1мм. Работает с замкнутыми площадями образованными любыми примитивами кроме SPLINE. (это надо еще доработать). За один сеанс можно указать несколько точек в разных контурах и в конце получить их сумму площадей и периметров. Код получился довольно громоздкий, поэтому сдесь размещать не буду, найдете сдесь http://www.apelsi.narod.ru/lisp.html

[{Smirnoff}]

>Apelsinov
Превосходный ЛИСП! Я тоже вчера эксперементировал с BOUNDARY, но чтобы добиться подобных результатов, надо еще работать. Единственное, исправьте ошибочку. У вас усть функция MODES, она в 4-й строке вызываеться как _MODES, соответственно выскакивает ошибка.

>Dima
Я дорабатываю. Будет 3 режима. Выбор замкнутых объектов, выбор "фиктивно" замкнутых объектов (с Boundary), выбор по точкам. Также будет суммирование. С масштабом, я напортачил :? ... Вот вам пока, рабочая функция для замкнутых объектов. Мастаб 1:1 для чертежа 1:1 в миллиметрах, есть настройка высоты шрифта.

Код:

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

(defun c:are (/ temp_scal obj obj_area selection option are_sum cur_area)
  (setvar "cmdecho" 0)
  (vl-load-com)
(if (not scal)(setq scal 1.0))
(if(not theight)(setq theight 250.0))
(setq are_sum 0.0)
(are_comline)
  (while T
    (princ "Select closed object or [Esc] to Quit ")
(setq selection (car(entsel)))
    (if (/= selection nil)
      (progn
	 (setq obj (vlax-ename->vla-object selection))
	       (if (= T (vlax-property-available-p obj "Area"))
		 (progn
	       (setq obj_area (rtos(setq cur_area(/(vla-get-area obj)(* (* (/ 1 scal)1000)(* (/ 1 scal)1000))))2 2))
(command "_.text" "0,0" theight "0" (strcat obj_area " m*2")
"_.copybase" "0,0" (entlast)"" "_.erase" (entlast)"" "_.pasteclip" pause)
	       (setq are_sum(+ are_sum cur_area))
	       (terpri)
	       (princ (strcat "*** Current area = "(rtos cur_area 2 2)", Area summary = "(rtos are_sum 2 2)" ***"))
	        (terpri)
		 );end progn
(alert "Object is not closed!\nSelect other object or press [Esc] to Quit.")
	       );end if
	);end progn
      (alert "Object is not selected!\nSelect object or press [Esc] to Quit.")
      );end if
    );end while
	 (princ)
	);end are

(defun are_comline (/ option)
  (setq option(getstring(strcat
"Drawing scale <1:"(rtos scal 2 2)">/text Size <"(rtos theight 2 1)"> or Enter to Continue. ")))
       (if (not (or (= "D" option)(= "S" option)(= "" option)))
	 (progn
(alert "Invalid input!\nOptions avaliable:\nD - set drawing scale,\nS - set text size,\nW - set text width.")
	   (are_comline)
	   );end progn
	 );end if
      (cond
	((= "D" option)(are_scal))
	((= "S" option)(are_theighght))
	);end cond
	   (princ)
	   );end are_comline


(defun are_scal (/ temp_scal)	
  (setq temp_scal scal)
  (setq scal(getreal (strcat "Enter scale <1:"(rtos scal 2 2)">: ")))
  (if (= scal nil)(setq scal temp_scal))
  (are_comline)
  (princ)
  );end are_scal

(defun are_theight (/ temp_theight)
  (setq temp_theight theight)
  (setq theight(getreal (strcat "Enter text size <"(rtos theight 2 1)">: ")))
  (if (= theight nil)(setq theight temp_theight))
  (are_comline)
  (princ)
  );end are_theight

[Grinzaid]

Я себе такую простую штуку накалякал, и она работает:

Код:

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

(defun c:wo()
(setq scale (getreal "\Enter drawing scale value: "))
(setq precision (getint "\Enter precision of number: "))
)

(defun c:wa()
(setq inspointext (getpoint "\Pick an insertion point of string: "))
(command "-boundary" "a" "o" "r" "" inspointext "")
(command "area" "e" "l")
(command "erase" "l" "")
(command "cmdecho" "1" "")
(setq areareal (getvar "area"))

(setq aaa (/(/ areareal scale)scale))
(setq aaaa (rtos aaa 2 precision))
(command "text" inspointext pause pause aaaa)
(setq aaa nil)
(setq aaaa nil)
(setq areareal nil)
)

Писал под свои нужды, простите, если чего не учёл. Под SCALE имел в виду разницу между ед. черчения и ед. замера. Если чертёж подразумевается в сm, а мерять площадь надо в м. кв., то надо ввести SCALE = 100. Завтра буду дорабатывать до общего случая с введением опций для ед. черчения, ед. замера и метода выбора площади или объекта. А на сегодня лимит занятий ерундой в раб. время исчерпан.

[{Smirnoff}]

Странное дело, в моем коде при выборе опции BOUNDARY, программа очень заметно тормозит. Пытаюсь разобраться. Ну если не разберусь, придеться помощи просить.

[Grinzaid]

Скорость работы boundary зависит от загруженности экрана (не файла, а именно экрана). Приблизьтесь к выбираемой прощади зумом, и программа заработает быстрее.

Надеюсь, что я Вас правильно понял.

[{Smirnoff}]

А ведь точно! Пробовал я на реальном чертеже, а там домик 11-ти этажный, и по крайней мере два этажа в вид попадали. Надо попробовать делать ZOOM при выполнении этой функции. На нарисованном в чистом файле прямоугольнике, все быстро. Надо еще "апельсиновый" код, повнимательней посмотреть, у него на том же чертеже "притормаживает", ну только самую малость и защита от сбоев вся написана.

[Grinzaid]

Чуть доработал. Но как объединить обе функции в одну команду, чтобы лишь однажды задать определения, а потом только заверять заданные значкния в <>? А ещё лучше для изменения запрашивать подфункцию:
Pick an insertion point of string [Drawing units/Necessary units]:

Я - начинающий в AuloLISP, и пока до такого грамотного построения не дошёл. Подскажите, а? :roll:

Код:

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

(defun c:wo()
(setq dunit (getstring "\Enter youf drawing units: mm/cm/m  <>"))
(setq runit (getstring "\Enter necessary result units: mm/cm/m  <>:"))
(setq precision (getint "\Enter precision of number: "))
)

(defun c:wa()
(cond
	((= dunit "mm") 
	(setq d 0.001)
	)
	((= dunit "cm") 
	(setq d 0.01)
	)
	((= dunit "m") 
	(setq d 1)
	)
);cond

(cond
	((= runit "mm") 
	(setq r 0.001)
	)
	((= runit "cm") 
	(setq r 0.01)
	)
	((= runit "m") 
	(setq r 1)
	)
);cond

(setq scale (/ r d))

(setq inspointext (getpoint "\Pick an insertion point of string: "))
(command "-boundary" "a" "o" "r" "" inspointext "")
(command "area" "e" "l")
(command "erase" "l" "")
(command "cmdecho" "1" "")
(setq areareal (getvar "area"))

(setq aaa (/(/ areareal scale)scale))
(setq aaaa (rtos aaa 2 precision))
(command "text" inspointext pause pause aaaa)
(setq aaa nil)
(setq aaaa nil)
(setq areareal nil)
);defun c:wa

[Startrek]

(defun c:ar1 (/ cl cm scl ht1 pt1 ar ht lb lay)
(setq cl (getvar "clayer"))
(setq cm (getvar "cmdecho"))
(setvar "cmdecho" 1)
(setq scl (getvar "dimscale"))
(setq ht1 (rtos (* 0.125 scl) 2 2))
(command "area" "o" pause)
(setq ar (getvar "area"))
(setq lay (tblsearch "layer" "label$"))
(if
(= lay nil)
(command "-layer" "m" "label$" "")
)
(setvar "clayer" "label$")
(setq lb (tblsearch "style" "label$"))
(if
(= lb nil)
(command"-style" "label$" "romans" "" "" "" "" "" "")
)
(setq ht (getstring (strcat "Text Hight: <" ht1 ">") ))
(if (= ht "")(setq ht ht1))
(setq pt1 (getpoint"\nLabel Insertion Point"))
(command "text" pt1 ht "" (rtos ar 2 2))
(setvar "clayer" cl)
(setvar "cmdecho" cm)
(princ)
)