Lisp в 3D

Lisp в 3D · 02.02.2009, 21:54

Доброго времени суток, товарищи!

Помогите, кто может, решить такую проблему: необходимо повернуть объект (блок, примитив и т.д.) в трехмерном пространстве НЕ используя COMMAND и VL-CMDF, желательно оперируя группами характеристик объекта (например 210). Причем так, чтобы выглядело это наглядно, как с командой ROTATE, но вокруг заданой оси, а не только в плоскости XY. Опять же, нельзя менять систему координат

Заранее спасибо!

eugen81 · 04.02.2009, 21:58

Кулик Алексей aka kpblc, спасибо за совет

И все же, вопрос остается открытым: Необходимо повернуть/переместить объект вокруг/вдоль заданной оси мышью с отслеживанием положения.

eugen81 · 04.02.2009, 22:10

Кулик Алексей aka kpblc, по крайней мере извлечение до сих пор необходимой мне информации (в основном атибуты блоков и, собственно, имен примитивов для построения спецификаций) не представляло проблем, потому что информация эта находилась во вполне ожидаемых местах и в необходимом объеме. Функцию для вытаскивания атрибутов при почти полном отсутствии опыта программирования в лисп написал и отладил за 15 минут. Проблемой было определить местоположение этой информации, так как справочник ввиду его специфичности удалось приобрести много позже.
Если кому интересно выкладываю код функции. Сразу оговорюсь - атрибуты в блоке для удобства имеют вид "Dy 50" "L 150"

Код:

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

; Функция извлечения данных из только что вставленного блока
(DEFUN GETDATA (/ ATTR ENAME DATA NAME TABLE INC_ENAME INC_TYPE INC_DATA ATTR)
  (SETQ ATTR nil)
  ; Получаем имя только что загруженного примитива
  (SETQ ENAME (ENTLAST))
  ; Получаем данные примитива
  (SETQ DATA (ENTGET ENAME))
  ; Выделяем имя блока
  (SETQ NAME (CDR (ASSOC 2 DATA)))
  ; Ищем это имя в таблице блоков
  (SETQ TABLE (TBLSEARCH "BLOCK" NAME))
  ; Выделяем имя первого вхождения в блок
  (SETQ INC_ENAME (CDR (ASSOC -2 TABLE)))
  ; Запускаем цикл, в котором ищем вхождение ATTDEF
  (WHILE (/= INC_ENAME nil)
    ; Получаем его данные
    (SETQ INC_DATA (ENTGET INC_ENAME))
    ; Выделяем тип вхождения
    (SETQ INC_TYPE (CDR (ASSOC 0 INC_DATA)))
    ; Проверяем, является ли INC_TYPE "ATTDEF". Если условие выполнено,..
    (IF (= INC_TYPE "ATTDEF")
      ; ...то создаем список, вида ("ИМЯ" <значение>)
      (SETQ ATTR (APPEND ATTR (LIST (LIST (CDR (ASSOC 2 INC_DATA)) (ATOF (CDR (ASSOC 1 INC_DATA))))))))
      ; Следующее вхождение
      (SETQ INC_ENAME (ENTNEXT INC_ENAME)))
  (SETQ BLOCK (STRCAT NAME ENAME ATTR))
  (PRINC))

Кулик Алексей aka kpblc · 04.02.2009, 22:37

Мой слегка переделанный вариант:

Код:

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

(vl-load-com)

(defun get-attr-by-mask (ent mask / _kpblc-conv-vla-to-list
                         _kpblc-conv-ent-to-ename _kpblc-conv-ent-to-vla)
                        ;|
*    Получение указателей на атрибуты вхождения блока
*    Параметры вызова:
	ent	указатель на вхождение блока (ename или vla-object)
	mask	маска тэга атрибута (nil -> "*"). Регистронезависима.
*    Примеры вызова:
(get-attr-by-mask (car (Entsel "\nУкажи блок : ")) nil)	; возвращает
	; список указателей на все атрибуты указанного блока
(get-attr-by-mask (car (Entsel "\nУкажи блок : ")) "*det*")	; возвращает
	; список указателей на все атрибуты указанного блока, в тэге которых
	; содержится последовательность DET
|;

  (defun _kpblc-conv-ent-to-ename (ent_value /)
                                  ;|
*    Функция преобразования полученного значения в ename
*    Параметры вызова:
*	ent_value	значение, которое надо преобразовать в примитив. Может
*			быть именем примитива, vla-указателем или просто
*			списком.
*			Если не принадлежит ни одному из указанных типов,
*			возвращается nil
*    Примеры вызова:
(_kpblc-conv-ent-to-ename (entlast))
(_kpblc-conv-ent-to-ename (vlax-ename->vla-object (entlast)))
|;
    (cond
      ((= (type ent_value) 'vla-object)
       (vlax-vla-object->ename ent_value)
       )
      ((= (type ent_value) 'ename) ent_value)
      ((= (type ent_value) 'str) (handent ent_value))
      ((= (type ent_value) 'list) (cdr (assoc -1 ent_value)))
      (t nil)
      ) ;_ end of cond
    ) ;_ end of defun

  (defun _kpblc-conv-ent-to-vla (ent_value / res)
                                ;|
*    Функция преобразования полученного значения в vla-указатель.
*    Параметры вызова:
*	ent_value	значение, которое надо преобразовать в указатель. Может
*			быть именем примитива, vla-указателем или просто
*			списком.
*			Если не принадлежит ни одному из указанных типов,
*			возвращается nil
*    Примеры вызова:
(_kpblc-conv-ent-to-vla (entlast))
(_kpblc-conv-ent-to-vla (vlax-ename->vla-object (entlast)))
|;
    (cond
      ((= (type ent_value) 'vla-object) ent_value)
      ((= (type ent_value) 'ename) (vlax-ename->vla-object ent_value))
      ((setq res (_kpblc-conv-ent-to-ename ent_value))
       (vlax-ename->vla-object res)
       )
      ) ;_ end of cond
    ) ;_ end of defun

  (defun _kpblc-conv-vla-to-list (value / res)
                                 ;|
*    Преобразовывает vlax-variant или vlax-safearray в список.
|;
    (cond
      ((listp value)
       (mapcar (function _kpblc-conv-vla-to-list) value)
       )
      ((= (type value) 'variant)
       (_kpblc-conv-vla-to-list (vlax-variant-value value))
       )
      ((= (type value) 'safearray)
       (if (>= (vlax-safearray-get-u-bound value 1) 0)
         (_kpblc-conv-vla-to-list (vlax-safearray->list value))
         ) ;_ end of if
       )
      ((and (member (type value) (list 'ename 'str 'vla-object))
            (setq value (_kpblc-conv-ent-to-vla value))
            (and (= (type value) 'vla-object)
                 (vlax-property-available-p value 'count)
                 ) ;_ end of and
            ) ;_ end of and
       (vlax-for sub (_kpblc-conv-ent-to-vla value)
         (setq res (cons sub res))
         ) ;_ end of vlax-for
       )
      (t value)
      ) ;_ end of cond
    ) ;_ end of defun

  (if (and (setq mask (if (or (not mask) (/= (type mask) 'str))
                        "*"
                        (strcase mask)
                        ) ;_ end of if
                 ) ;_ end of setq
           (setq ent (cond
                       ((= (type ent) 'ename) (vlax-ename->vla-object ent))
                       ((= (type ent) 'vla-object) ent)
                       (t nil)
                       ) ;_ end of cond
                 ) ;_ end of setq
           ) ;_ end of and
    (vl-remove-if-not
      (function
        (lambda (x)
          (wcmatch (strcase (vla-get-tagstring x)) mask)
          ) ;_ end of lambda
        ) ;_ end of function
      (apply (function append)
             (mapcar (function _kpblc-conv-vla-to-list)
                     (list (vla-getattributes ent)
                           (vla-getconstantattributes ent)
                           ) ;_ end of list
                     ) ;_ end of mapcar
             ) ;_ end of apply
      ) ;_ end of vl-remove-if-not
    ) ;_ end of if
  ) ;_ end of defun

Один из вариантов использования:

Код:

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

(mapcar (function (lambda(x) (cons (vla-get-TagString x) (vla-get-TextString x)))) (get-attr-by-mask (car (entsel "\nУкажи блок : ")) "*"))
; (("DETAIL#" . "1"))

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

eugen81 · 04.02.2009, 23:02

Кулик Алексей aka kpblc, "слегка", говоришь?

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

Кулик Алексей aka kpblc · 04.02.2009, 23:13

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

eugen81 · 05.02.2009, 09:22

Кулик Алексей aka kpblc, в теме DwgRuLispLib: Получение указанного свойства объекта какие конкретно свойства объекта показываются? те, которые отражаются в Properties?

Кулик Алексей aka kpblc · 05.02.2009, 09:26

Так там же все написано. Есть объект, есть у него запрашиваемое свойство. Например, у текста - значение строки. Для получения в свою программу вызываем (setq text (_dwgru-property-get (car (entsel)) 'textstring)) и дальше используется уже значение переменной text

Елпанов Евгений · 05.02.2009, 11:08

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

Сама программа, выполнена в формате библиотечной функции:

Код:

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

(defun eea-ins-bl (a b c / D E F G L)
  ;; By ElpanovEvgeniy
  ;; 05.02.2009
  ;; for
  ;; http://forum.dwg.ru/showthread.php?t=29842
  ;;
  ;; Программа динамической вставки блока с поворотом вокруг оси.
  ;; Система координат чертежа - любая
  ;; Система координат поворачиваемого блока - любая
  ;; Во время поворота, находится точка пересечения
  ;; луча взгляда на курсор и плоскости блока.

  ;; Программа не использует VLA функции
  
  ;;a - point
  ;;b - vector
  ;;c - name block

  ;|
  Пример использования:

(defun c:test (/ a b c)
  (princ
    "\n Укажите на чертеже блок, копию которого необходимо использовать"
  )
  (if (and
	(setq c (ssget "_+.:S:E" '((0 . "insert"))))
	(setq a (getpoint "\n Укажите точку вставки блока"))
	(setq
	  b (getpoint "\n Укажите точку в направлении оси построений")
	)
      )
    (eea-ins-bl
      a
      (mapcar '- b a)
      (cdr (assoc 2 (entget (ssname c 0))))
    )
  )
)
  |;
  (if (tblobjname "block" c)
    (progn
      (entmake
	(list
	  '(0 . "INSERT")
	  '(100 . "AcDbEntity")
	  '(410 . "Model")
	  (cons 8 c)
	  '(100 . "AcDbBlockReference")
	  (cons 2 c)
	  (cons 10 (trans a 1 (trans b 1 0 t)))
	  '(50 . 0.)
	  (cons 210 (trans b 1 0 t))
	)
      )
      (setq e (ssname (ssget "_l") 0)
	    l (entget e)
      )
      (while (= (car (setq g (grread nil 5 0))) 5)
	(setq
	  d (mapcar '- (trans (cadr g) 1 e t) (trans a 1 e t))
	  f (mapcar '+ (trans '(0 0 1000.) 2 e t) d)
	  l
	    (entmod
	      (subst
		(cons 50
		      (angle
			'(0 0 0)
			(inters	d
				f
				(list (car d) (cadr d) 0)
				(list (car f) (cadr f) 0)
				nil
			)
		      )
		)
		(assoc 50 l)
		l
	      )
	    )
	)
	(redraw)
	(grdraw a (cadr g) 1)
      )
    )
  )
(redraw)
)

Пример использования программы:

Код:

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

(defun c:test (/ a b c)
  (princ
    "\n Укажите на чертеже блок, копию которого необходимо использовать"
  )
  (if (and
	(setq c (ssget "_+.:S:E" '((0 . "insert"))))
	(setq a (getpoint "\n Укажите точку вставки блока"))
	(setq
	  b (getpoint "\n Укажите точку в направлении оси построений")
	)
      )
    (eea-ins-bl
      a
      (mapcar '- b a)
      (cdr (assoc 2 (entget (ssname c 0))))
    )
  )
)

eugen81 · 05.02.2009, 12:21

Вот за это - огромное человеческое спасибо! вечером буду разбираться в коде

eugen81 · 06.02.2009, 09:53

Вот только еще один вопрос. Как заставить функцию grread считывать значения с учетом привязок?

Donhuan · 06.02.2009, 13:46

http://www.caduser.ru/cgi-bin/f1/board.cgi?t=36171KD

eugen81 · 06.02.2009, 14:38

Donhuan, Спасибо!

Donhuan · 06.02.2009, 14:46

Еще здесь:
http://www.caduser.ru/cgi-bin/f1/board.cgi?t=20084JC

eugen81 · 14.02.2009, 16:05

Подскажите в чем проблема:
В свойствах блока, вставляемого из файла, код 10 содержит координаты базовой точки, иначе точку начала координат в СК блока. Вроде так?
На скрине показан такой блок с измененными кодами 10, 50 и 210. код 10 блока содержит координаты (10 -129.273 91.8469 0.0), а на рисунке базовая точка находится в точке 0.0 -129.273 91.846. Как такое может быть?
До этого у блока менялись коды 50 и 210. Может быть в результате этого произошло смещение СК блока?

Заранее спасибо!

P.S., догадался, вошел в режим редактирования блока, посомотрел - там все как было, все на месте

В общем почему-то координаты точки в группе 10 отображаются со смещением - вместо X показывает Y, вместо Y - Z, соответственно вместо Z - X.

Дима_ · 14.02.2009, 18:43

Цитата:

Сообщение от eugen81

В общем почему-то координаты точки в группе 10 отображаются со смещением - вместо X показывает Y, вместо Y - Z, соответственно вместо Z - X.

Во первых в начале проверь соответствие UCS (ПСК), все dxf коды возвращаються в мировой системе (для перевода используй (trans...)), во вторых, как в твеом случае, у тебя вероятно изменен 210 атрибут, вместо (0 0 1) показывает (1 0 0) - а 210 это простыми словами единичный вектор направления оси Z вхождения блока относительно мировой системы координат, кстати если его изменяешь не обязательно приравнивать к единице автокад и так проглатывает.

zamtmn · 14.02.2009, 19:54

>>Может быть в результате этого произошло смещение СК блока?
у тебя система координат блока повернута, z направлен по x wcs. такчто все верно, почитай в справке как считается ск объектов в разделе Arbitrary Axis Algorithm

eugen81 · 15.02.2009, 11:16

Спасибо! С помощью trans все отлично получилось

eugen81 · 21.02.2009, 11:18

Елпанов Евгений, в вашем коде там, где вы вычисляете переменную f, точка (0 0 1000) переводится из ЭСК в СК блока. Объясните пожалуйста, почему именно "1000"?

Елпанов Евгений · 21.02.2009, 22:40

Цитата:

Сообщение от eugen81

Объясните пожалуйста, почему именно "1000"?

Это не именно "1000", а просто 1000.
Если не нравится 1000, замените на другое число, например 38...

eugen81 · 22.02.2009, 08:44

Понятно. Тогда следующий вопрос

Как использовать 3dorbit, не прерывая исполнение программы?

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Конструирование в 3D	Serz	AutoCAD	87	28.10.2014 10:40
Lisp Как поставить диаметр отверстия на 3D solidе	P4s8x	LISP	4	06.11.2008 19:31
Как тело построенное 3D Face превратить в 3D Solid?	Bdod	AutoCAD	37	03.08.2006 11:36
загрузка DOS прог через LISP	Gaa	LISP	15	12.08.2005 19:19

02.02.2009, 21:54
Lisp в 3D eugen81 ООО Предприятие "Ирбис" Екатеринбург Регистрация: 02.02.2009 Сообщений: 45 Доброго времени суток, товарищи! Помогите, кто может, решить такую проблему: необходимо повернуть объект (блок, примитив и т.д.) в трехмерном пространстве НЕ используя COMMAND и VL-CMDF, желательно оперируя группами характеристик объекта (например 210). Причем так, чтобы выглядело это наглядно, как с командой ROTATE, но вокруг заданой оси, а не только в плоскости XY. Опять же, нельзя менять систему координат Заранее спасибо! Последний раз редактировалось eugen81, 03.02.2009 в 21:17.
Просмотров: 13311