[Krieger]

Такой вопросик:
Как сделать набор элементов состоящих, допустим, только из линии?
Т.е. ssget, только выбирать функция должна только то что надо.

[Кулик Алексей aka kpblc]

> Krieger : Ну извини, на что хватило, то и сделал Работа-то тоже висит - типа сделать там надо btw, я в ActiveX тоже не Копенгаген, что с удовольствием подтвердит Лентяй
Насчет стилей:
Список размерных стилей можно получить, например, так:

Код:

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

  (vlax-for item
	    (vla-get-dimstyles (vla-get-activedocument (vlax-get-acad-object)))
    (setq dimstylelst (append dimstylelst (list (vla-get-name item))))
    ) ;_ end of vlax-for

И делай со списком что хочешь Например, чтоб получить имена стилей с "*data*" внутри, можно и таким воспользоваться:

Код:

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

(setq	dimstylelst
	 (vl-remove-if-not
	   '(lambda (x) (wcmatch (strcase x t) "*data*"))
	   dimstylelst
	   ) ;_ end of vl-remove-if-not
	) ;_ end of setq

> ShaggyDoc : Я так понимаю, что в основном критика мне адресована?
> Krieger :

Кстати как грамотно выйти при пустом вводе из функции while

Как обычно

Код:

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

(while (setq ins_pt (getpoint "\nТочка вставки <Выход> : "))
;; Тра-ля-ля...
)

[ShaggyDoc]

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

Все проверки, блокировки, обработка ошибок спрятаны внутри спецфункций ru-*, загружаемых в главной библиотеке.

Рисование треугольника производится просто солидом, без создания блока.

Код:

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

(defun ru-weld-catet (layer_name / catet old_layer pnt_vertex solid)
;; (ru-weld-catet "сварка")
;; Восстанавливаем значение по умолчанию,
;; причем переводим его из миллиметров на бумаге в единицы рисунка
  (setq catet (ru-conv-millimeter-in-paper-to-unit
                (atof (ru-user-read-last-param "catet_weld_on_paper" "2.0"))
              ) ;_ end of ru-conv-millimeter-in-paper-to-unit
  ) ;_ end of setq
;; Делаем текущим заданный слой. Если такого слоя нет, он будет создан
;; если был заблокирован - разблокируется
  (if layer_name
    (progn (setq old_layer (getvar "clayer"))
           (ru-layer-current layer_name)
    ) ;_ end of progn
  ) ;_ end of if
;; В цикле выполняем запрос вершины
;; При этом указывается величина катета, а в контекстном меню создается пункт Катет,
;; при выборе которого можно изменить величину катета.
;; Если уже был нарисован треугольник, дополнительно появляется опция Отмени,
;; при выборе которой последний нарисованный треугольник стирается.
;; Для выхода из цикла появляется действие по умолчанию Выход.
;;
;|
Примерный протокол работы:

СВАРНОЙ ШОВ: Катет 2 мм на бумаге. Вершина треугольника  [Катет]<Выход>:
Направление первого угла:
Направление второго угла:
СВАРНОЙ ШОВ: Катет 2 мм на бумаге. Вершина треугольника  
[Катет/Отмени]<Выход>:К
Катет шва, мм на бумаге  <2.0>:3
СВАРНОЙ ШОВ: Катет 3 мм на бумаге. Вершина треугольника  [Катет/Отмени]<Выход>:
Направление первого угла:
Направление второго угла:
СВАРНОЙ ШОВ: Катет 3 мм на бумаге. Вершина треугольника  [Катет/Отмени]<Выход>:О

СВАРНОЙ ШОВ: Катет 3 мм на бумаге. Вершина треугольника  [Катет]<Выход>:
|;
  (while (setq pnt_vertex
                (ru-get-point-or-exit
                  (strcat "СВАРНОЙ ШОВ: Катет "
                          (rtos (ru-conv-unit-to-millimeter-in-paper catet) 2 2)
                          " мм на бумаге. Вершина треугольника"
                  ) ;_ end of strcat
                  (if solid
                    "Катет Отмени"
                    "Катет"
                  ) ;_ end of if
                ) ;_ end of ru-get-point-or-exit
         ) ;_ end of setq
    (cond
      ((= pnt_vertex "Катет")
       ;; Запрос нового размера с значением по умолчанию
       (setq catet (ru-conv-millimeter-in-paper-to-unit
                     (ru-get-dist
                       "Катет шва, мм на бумаге"
                       (ru-conv-unit-to-millimeter-in-paper catet)
                       nil
                     ) ;_ end of ru-get-dist
                   ) ;_ end of ru-conv-millimeter-in-paper-to-unit
       ) ;_ end of setq
      )
      ((= pnt_vertex "Отмени")
       ;; Удаление последнего треугольника
       (ru-obj-ent-ss-erase solid)
       (setq solid nil)
      )
      ((ru-is-point pnt_vertex)
       ;; Рисование треугольника солидом
       (setq solid (ru-obj-add-solid
                     pnt_vertex
                     (polar pnt_vertex
                            (angle pnt_vertex
                                   (ru-get-point-reguired
                                     "Направление первого угла"
                                     pnt_vertex
                                   ) ;_ end of ru-get-point-reguired
                            ) ;_ end of angle
                            catet
                     ) ;_ end of polar
                     (polar pnt_vertex
                            (angle pnt_vertex
                                   (ru-get-point-reguired
                                     "Направление второго угла"
                                     pnt_vertex
                                   ) ;_ end of ru-get-point-reguired
                            ) ;_ end of angle
                            catet
                     ) ;_ end of polar
                     pnt_vertex
                   ) ;_ end of ru-obj-add-solid
       ) ;_ end of setq
      )
    ) ;_ end of cond
  ) ;_ end of while
  (if old_layer
    (ru-layer-current old_layer)
  ) ;_ end of if
  ;; Сохранение значения катета
  (ru-user-write-last-param "catet_weld_on_paper" (rtos (ru-conv-unit-to-millimeter-in-paper catet) 2 3))
  (ru-app-end)
  (princ)
) ;_ end of defun

[aldt]

Есть minЗначение и maxЗначение, необходимо вывести
шкалу значений (цветом) по диапазонам.
(vlisp)может кто-то решал уже данную проблему.

[Krieger]

Цикличность я добавил, обработку ошибок сделал, пустой ввод обрабатывается, проверку наличия слоя сделал. На первое время сойдет, а чтобы сделать как советует ShaggyDoc мне еще работать и работать :cry: , но к этому надо стремиться.

[ShaggyDoc]

to kpbls >

ShaggyDoc : Я так понимаю, что в основном критика мне адресована?

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

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

Функция Kr_AngleWeld удовлетворяет автора - и хорошо. Она проста и без всяких "закавыков". И всегда можно подправить себе (undo включить и т.п.). Для массового, "отчужденного" использования надо делать сложнее внутри (это скрыто от пользователя) и проще и гибче "снаружи"

> Krieger

мне еще работать и работать

Да не так уж много - вот kpbls не очень давно начал с LISP разбираться, а уже может сделать программу любой сложности. Ему бы только время, да постановку, если тема плохо знакома. "Я так думаю" (С)

[Евгений А.]

Господа, хорошие!!! Есть ли какая-нибудь приличная (!) альтернатива команде "_area" для вычисления площади поверхности твёрдого тела. (Хотелось бы ActiveX методы) Проблема c "_area" - не могу её применить для тел лежащих внутри блоков, не открывая редактор блока, а это очень сильно замедляет программу если блоков выше крышы!!!
[sm1400]
????

[vk]

Сообщение от Евгений А. ...альтернатива команде "_area" для вычисления площади поверхности твёрдого тела. (Хотелось бы ActiveX методы) Проблема c "_area" - не могу её применить для тел лежащих внутри блоков, не открывая редактор блока...

Ежели блок предполагается вставлять с одинаковыми масштабными коэффициентами по осям, то скорей всего особо много вычислять то ничего не надо... Ввести в состав блока скрытый атрибут к примеру, да прописать туда площадь при единичном масштабе. Это достаточно сделать один раз, а потом только читать значение атрибута. Остальное вроде чистая математика...
Как вариант - прицепить значения непосредственно к телам (например, в XDATA) после их создания или при создании блока.

[Кулик Алексей aka kpblc]

Можно по идее попробовать получить примитив через (nentsel) и к нему уже применять _area

[Евгений А.]

Сообщение от vk .... прописать туда площадь при единичном масштабе. Это достаточно сделать один раз, а потом...

Именно этот момент и получается очень медпенным - программе приходится открыть редактор блока, потом его закрыть, а тут на тебе - регенерация всего рисунка (большого). Целых три тормоза (даже если выключать регенерацию)....

-> kpblc
Команда: (setq ename (car (nentsel)))(print ename)(command "_area" "О" ename)
;выбираю вложенное тело:
Выберите объект:
<Имя объекта: 7ef70e50> _area
Первая угловая точка или [Объект/Добавить/Вычесть]: О
Выберите объекты: <Неверное имя объекта: 7EF70E50>
nil
"_area" по всей видимости дружит только с примитивами экрана (как например "ssget"

[Кулик Алексей aka kpblc]

Похоже на особенность функциклирования _area. У меня тоже не сработало

[VVA]

>Евгений А.
Если попробовать так

Код:

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

(defun s_area ( / sset vla-list name ObjNme Sum_area)
  (setq Sum_area 0)
(if (setq sset (ssget "_X" ))
  (progn 
    (setq vla_list (mapcar (function vlax-ename->vla-object)
	            (vl-remove-if (function listp)
		      (mapcar (function cadr) (ssnamex sset))))
	  sset nil )
  (foreach item vla_list
    (setq name (vla-get-ObjectName item))
    (cond
      ((member name '("AcDb3dSolid")) ;_Довить объекты, площадь которых считаем
	(if (not (VL-CATCH-ALL-ERROR-P
	    (VL-CATCH-ALL-APPLY
	      '(lambda ()(vl-cmdf "_.AREA" "_O" (vlax-vla-object->ename item))))))
	  (setq Sum_area (+ Sum_area (getvar "AREA"))))
       )
      ((= name "AcDbBlockReference")
       (foreach memb (vlax-invoke item 'Explode)
	  (setq ObjNme (vla-get-ObjectName memb))
	  (cond
	    ((member ObjNme '("AcDb3dSolid" ))
		(if (not (VL-CATCH-ALL-ERROR-P
		    (VL-CATCH-ALL-APPLY
		      '(lambda ()(vl-cmdf "_.AREA" "_O" (vlax-vla-object->ename memb))))))
		  (setq Sum_area (+ Sum_area (getvar "AREA"))))
	       )
	   ((eq ObjNme "AcDbBlockReference")
	    nil
	    ;Пропускаем вложенные блоки, если надо - делай рекурсию
	    ;http://www.autocad.ru/cgi-bin/f1/board.cgi?t=25113OT
	    )
	   (T nil))
	  (vla-Delete memb))
	 )
       )
       );_foreach item
    
    ));_if
  (princ "\nСуммарная площадь= ")(princ Sum_area)(princ)
  )

[vk]

Сообщение от Евгений А. Сообщение от vk .... прописать туда площадь при единичном масштабе. Это достаточно сделать один раз, а потом... Именно этот момент и получается очень медпенным - программе приходится открыть редактор блока, ....

Один вопрос, зачем открывать/закрывать?

[Евгений А.]

-> VVA Очень интересно, почему после (vlax-invoke item 'Explode) само вхождение остаётся в рисунке? (думал оно автоматом удаляется!)
Работает довольно быстро, большое спасибо, но моя программа как вы и хотели вначале должна создать именно атрибут с площадью тела в блоке. Есть на входе <имя примитива> 3dsolid в описании блока, нужна его площадь. Я делаю примерно так:

Код:

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

(entmake (entget (ename)))
(command "_area" "Î" (entlast))
(setq area (getvar "area"))
(entdel (entlast))

Работает довольно быстро, но ведь это всё попытки обмануть Автокад, хотелось бы чего-нибудь проще (элегантнее).
А по поводу открывать-закрывать - это пример.

[VVA]

Очень интересно, почему после (vlax-invoke item 'Explode) само вхождение остаётся в рисунке?

Потому что в helpe написано

Remarks Depending on the type of compound object you're exploding, different results occur. Refer to theEXPLODE command topic in the AutoCAD Command Reference for a detailed list of explodable objects and their results. You do not have to explode a block in order to manipulate its constituent entities. All block definitions have an Item method that allow you to manipulate the entities within the block without exploding the block definition itself

[Евгений А.]

->VVA Пардон!!! обознался (VA)
Я кстати немецкий когдато изучал, а с английским PROMT выдаёт такую белиберду:
Вы не должны взорвать блок, чтобы управлять его объектами непосредственной составляющей. Все выделения блока имеют метод Элемента{Пункта}, которые позволяют Вам управлять объектами в пределах блока, не взрывая выделение блока непосредственно.

Да и вообще я с Автокадом и В. Лиспом только-только начал знакомиться...

[VVA]

вначале должна создать именно атрибут с площадью тела в блоке.

Я бы создавал в конце, по анализу Sum_area >0. Вдруг в блоке нет солидов?
А насчет атрибута, на форуме были лиспы по созданию блоков методами ActiveX как из примитивов так и из существеющих блоков. Поищи. А еще лучше спроси у kpblca. У него этого добра есть.
Например здесь
http://www.arcada.com.ua/forum/viewt...er=asc&start=0
сообщение Добавлено: Пт 23 Июн , 2006 12:37
и здесь http://my.opera.com/kpblc/blog/
Скачай Cadware и посмотри, там лисп, есть чего подсмотреть :wink:

Можно сделать проще, включить в новый блок обработанный + артибут с его площадью.

[VVA]

которые позволяют Вам управлять объектами в пределах блока, не взрывая выделение блока непосредственно

Зерно здесь.
Вы не дожны взрывать/ расчленять (бррр уголовшина) блок чтобы манипулировать с его примитивами. Все блоки (определения блоков) имеют метод Item, который позволяет манипулировать элементами блока без его взрывания.
Использование vla-item

[Кулик Алексей aka kpblc]

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

[Евгений А.]

->VVA :roll: Немного о разном говорим. Мне этот вопрос (area) интересен в целях образования. Как чего писать (за что спасибо!) это одно , а вот новая идея это другое. Эта часть программы у меня давно уже готова и работает, но осталось чувство что можно было бы лучше.
Ведь как работает "area" с телом - наверно, извлекает из тела грани, из них замкнутые полилинии, а дальше считает (как-то) площадь замкнутой полилинии (например, как vlax-curve-getArea), а где-то програмисты поленились или лоханулись и теперь у меня такая вот проблема. Может есть идеи с vlax-curve-getArea ??? Хотелось бы тут копать!!!

[Кулик Алексей aka kpblc]

Так ета... (vlax-curve-*), по-моему, работает только с кривыми, насколько я знаю. Солиды это другое.