Выдавливание и вычитание трехмерных объектов

HooDRooK · 02.04.2009, 07:17

Подскажите, господа знающие программисты, как программно (с помощью LISP) и проще выполнить следующие действия:
1. В трехмерном пространстве рисуется круг,
2. Нарисованный круг выдавливается на определённую высоту;
3. Из верхнего центра полученного циллиндра рисуется круг меньшего диаметра;
4. Круг 2 выдавливается с отрицательной высотой, равной высоте круга 1;
В общем в результате должен получиться циллиндр с отверстием посередине.
С Уважением!

Profan · 02.04.2009, 08:14

Зачем из верхнего центра?

VictorHunter · 02.04.2009, 08:17

Код:

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

(defun test1 (/	       adoc	pt	 rad1	  rad2	   lst
	      ext_circle	int_circle	  height   model
	      err      ext_reg	int_reg	 reg
	     )
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  ) ;_ end of vla-startundomark
  (if
    (and
      (= (type
	   (setq
	     pt	(vl-catch-all-apply
		  (function
		    (lambda () (getpoint "\nТочка центра <Отмена> : "))
		  ) ;_ end of function
		) ;_ end of vl-catch-all-apply
	   ) ;_ end of setq
	 ) ;_ end of type
	 'list
      ) ;_ end of =
      pt
      (= (type (setq rad1
		      (vl-catch-all-apply
			(function (lambda ()
				    (getdist pt "\nВнешний радиус <Отмена> : ")
				  ) ;_ end of lambda
			) ;_ end of function
		      ) ;_ end of vl-catch-all-apply
	       ) ;_ end of setq
	 ) ;_ end of type
	 'real
      ) ;_ end of =
      (= (type
	   (setq
	     rad2 (vl-catch-all-apply
		    (function
		      (lambda ()
			(getdist pt "\nВнутренний радиус <Отмена> : ")
		      ) ;_ end of lambda
		    ) ;_ end of function
		  ) ;_ end of vl-catch-all-apply
	   ) ;_ end of setq
	 ) ;_ end of type
	 'real
      ) ;_ end of =
      (= (type
	   (setq
	     height (vl-catch-all-apply
		      (function
			(lambda	()
			  (getdist "\nВысота выдавливания <Отмена> : ")
			) ;_ end of lambda
		      ) ;_ end of function
		    ) ;_ end of vl-catch-all-apply
	   ) ;_ end of setq
	 ) ;_ end of type
	 'real
      ) ;_ end of =
    ) ;_ end of and
     (if (vl-catch-all-error-p
	   (setq err (vl-catch-all-apply
		       (function
			 (lambda ()
			   (setq rad1	 (car (setq lst	(vl-sort (list rad1 rad2)
								 (function >)
							) ;_ end of vl-sort
					      ) ;_ end of setq
					 ) ;_ end of car
				 rad2	 (cadr lst)
				 model	 (vla-get-modelspace adoc)
				 ext_reg (vla-addregion
					   model
					   (vlax-safearray-fill
					     (vlax-make-safearray
					       vlax-vbobject
					       '(0 . 0)
					     ) ;_ end of vlax-make-safearray
					     (list (setq ext_circle
							  (vla-addcircle
							    model
							    (vlax-3d-point pt)
							    rad1
							  ) ;_ end of vla-addcircle
						   ) ;_ end of setq
					     ) ;_ end of list
					   ) ;_ end of vlax-safearray-fill
					 ) ;_ end of vla-addregion
				 int_reg (vla-addregion
					   model
					   (vlax-safearray-fill
					     (vlax-make-safearray
					       vlax-vbobject
					       '(0 . 0)
					     ) ;_ end of vlax-make-safearray
					     (list (setq int_circle
							  (vla-addcircle
							    model
							    (vlax-3d-point pt)
							    rad2
							  ) ;_ end of vla-addcircle
						   ) ;_ end of setq
					     ) ;_ end of list
					   ) ;_ end of vlax-safearray-fill
					 ) ;_ end of vla-addregion
				 reg	 (vla-boolean
					   (car	(vlax-safearray->list
						  (vlax-variant-value ext_reg)
						) ;_ end of vlax-safearray->list
					   ) ;_ end of car
					   acsubtraction
					   (car	(vlax-safearray->list
						  (vlax-variant-value int_reg)
						) ;_ end of vlax-safearray->list
					   ) ;_ end of car
					 ) ;_ end of vla-boolean
			   ) ;_ end of setq
			   (vla-addextrudedsolid
			     model
			     (car (vlax-safearray->list
				    (vlax-variant-value
				      ext_reg
				    ) ;_ end of vlax-variant-value
				  ) ;_ end of vlax-safearray->list
			     ) ;_ end of car
			     height
			     0.
			   ) ;_ end of vla-addextrudedsolid
			 ) ;_ end of lambda
		       ) ;_ end of function
		     ) ;_ end of vl-catch-all-apply
	   ) ;_ end of setq
	 ) ;_ end of vl-catch-all-error-p
       (princ (strcat "\nОшибка времени выполнения : "
		      (vl-catch-all-error-message err)
	      ) ;_ end of strcat
       ) ;_ end of princ
     ) ;_ end of if
  ) ;_ end of if
  (foreach item	(list ext_circle int_circle)
    (if	(and (vlax-write-enabled-p item)
	     (not (vlax-erased-p item))
	) ;_ end of and
      (vla-erase item)
    ) ;_ end of if
  ) ;_ end of foreach
  (vla-endundomark adoc)
  (princ)
) ;_ end of defun

Profan · 02.04.2009, 08:24

Заготовка в случае использования нижнего центра:

Код:

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

 
(defun C:TR ( / pt1 ent1 ent2)
(setq pt1 (getpoint "\n Укажите центр круга: "))
(vl-cmdf "_CIRCLE" pt1 50)
(vl-cmdf "_EXTRUDE" "_L" "" 200 "")
(setq ent1 (entlast))
(vl-cmdf "_CIRCLE" pt1 40)
(vl-cmdf "_EXTRUDE" "_L" "" 200 "")
(setq ent2 (entlast))
(vl-cmdf "_subtract" ent1 "" ent2 "")
(princ)
)

Кулик Алексей aka kpblc · 02.04.2009, 08:29

Profan, ты про osmode забыл.

Profan · 02.04.2009, 08:31

Алексей, я не забыл. Это же заготовка (рыба).

HooDRooK · 02.04.2009, 18:31

Заранее спасибо гопода программисты!...проверю что получилось по предложенным кодам как смогу (сейчас на выезде по работе)...Так что зайдите ещё раз пожалуйста, посмотри что напишу по поводу вопросов...
ЗЫ: всем по пиву...пишите адреса. куда пиво слать..

Рyslan · 02.04.2009, 19:57

что такое ent1 ent2?

Profan · 02.04.2009, 20:03

ent1 и ent2 - локальные переменные, в которых запоминаются имена последних отрисованных объектов. В данном случае это выдавленные цилиндры.

HooDRooK · 29.04.2009, 12:32

Ещё вопрос. Почему говорил что надо из верхнего центра вычитать потому что деталька состоит из нескольких таких установленных друг на друга циллиндров. Т.е. в предложенных кодах где запоминаются координаты подскажите?.

E-degtyarev · 04.05.2009, 09:48

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

Код:

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

(setq p1 (getpoint "\nУкажите центр круга"))
(setq r_b (getdist p1 "\nУкажите радиус большого круга"))
(setq r_m (getdist p1 "\nУкажите радиус малого круга"))
(setq v_z (getdist p1 "\nУкажите высоту цилиндра"))
(setq p2 (list (car p1) (cadr p1) v_z)); получение координат центра верхнего основания цилиндра
(command "_circle" p1 r_b);отрисовка большей окружности
(command "_extrude" (entlast) "" v_z);выдавливание большего цилиндра (вверх)
(setq zil_b (entlast));запомнить больший цилиндр для последующего вычитания
(command "_circle" p2 r_m);отрисовка меньшей окружности с центром в точке p2 (верхнее основание цилиндра)
(command "_extrude" (entlast) "" (- v_z));выдавливание меньшего цилиндра в отрицательном направлении (вниз)
(setq zil_m (entlast));запомнить меньший цилиндр для последующего вычитания
(command "_subtract" zil_b "" zil_m "");вычитание тел цилиндров

HooDRooK · 14.05.2009, 07:31

А теперь вот ещё вопрос...Как можно заставить лисп вычесть один объект сразу из двух?...
Например друг на друге с помощью circle и extrude два цилиндра. Из верхней точки рисуется один, высотой, равной сумме первых двух но меньшего диаметра. В общем должна получиться сквозная дырка.
Но вот если писать
(command "_subtract" zil_b3 "" zil_b5 "");âû÷èòàíèå òåë öèëèíäðîâ
(command "_subtract" zil_b2 "" zil_b5 "");âû÷èòàíèå òåë öèëèíäðîâ
где zil_b3- верхний циллиндр
zil_b2- нижний циллиндр
zil_b5- циллиндр, который надо вычетать из обоих

То естественно что последний циллиндр вычтется только из верхнего.

Кулик Алексей aka kpblc · 14.05.2009, 09:52

Либо объединяй 2 первых тела, либо копируй вычитаемое.

HooDRooK · 14.05.2009, 10:43

Вопрос такой...если я получаю координаты центра круга с помощью
.....
(setq p1 (getpoint "\nУкажите центр детали"));получение размеров нижнего циллиндра
(setq p2 (list (car p1) (cadr p1) L4)); получение координат центра верхнего основания цилиндра
......
каким образом я могу например начертить ещё несколько кругов меняя только значение по X или по Y? Т.е. чтобы одна координата нижнего центра оставалась неизменной а менялась только вторая...

E-degtyarev · 18.05.2009, 11:16

Код:

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

(setq p1 (getpoint "\nУкажите центр детали"));получение размеров нижнего циллиндра
(setq p2 (list (car p1) (cadr p1) L4)); получение координат центра верхнего основания цилиндра

;координаты центров оснований цилиндров можно получить так:
(setq p_n (list (+ (car p1) 100) (+ (cadr p1) 100) (caddr p1)));добавляя или вычитая известные Вам величины (здесь 100 и 100) к координатам  по X и Y
;либо:
(setq p_n (polar p1 (* pi 0.25) 140));где (* pi 0.25) - угол (здесь 45 градусов), 140- растояние между центрами окружностей

Валенок · 21.05.2009, 03:29

Внесу свои три копейки.

Ваше условие №1 - было рисовать в трехмере.
В моем понимании трехмер это не только вверх, а вообще в ЛЮБОМ направлении.

В силу специфики своей деятельности, в вашем примере увидел только трубу.

Вам принципиально рисовать выдавливанием цирклей ?

Предположил что для дальнейшей обработки может потребоватся какая-то информация о полученном объекте.

02.04.2009, 07:17		#1
Выдавливание и вычитание трехмерных объектов HooDRooK Регистрация: 11.03.2009 Сообщений: 33 Подскажите, господа знающие программисты, как программно (с помощью LISP) и проще выполнить следующие действия: 1. В трехмерном пространстве рисуется круг, 2. Нарисованный круг выдавливается на определённую высоту; 3. Из верхнего центра полученного циллиндра рисуется круг меньшего диаметра; 4. Круг 2 выдавливается с отрицательной высотой, равной высоте круга 1; В общем в результате должен получиться циллиндр с отверстием посередине. С Уважением!
Просмотров: 4046

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Набор объектов	DEM	Программирование	21	26.03.2014 19:11
FILTER / фильтр	BM60	Справочник команд	0	08.07.2008 15:35
Перевод трехмерных объектов в плоские	Jerald	AutoCAD	31	08.04.2007 01:15
как вырезать из набора трехмерных объектов область другим тр	bodya	AutoCAD	2	23.10.2006 00:28
Печать трехмерных объектов в Автокаде	Maxim_	AutoCAD	3	15.04.2004 16:07