dwg.ru forum rss xml
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Помогите с лабораторной по AutoLISP (построить 6 шестригранников на окружности)

Помогите с лабораторной по AutoLISP (построить 6 шестригранников на окружности)

Версия для печати
 
Ответ
Опции темы Поиск в этой теме
Непрочитано 07.11.2018, 16:55 #1
Помогите с лабораторной по AutoLISP (построить 6 шестригранников на окружности)
itshpit
 
Регистрация: 01.11.2018
Сообщений: 10

itshpit вне форума Вставить имя

Здравствуйте. Никак не получается выполнить лабораторную по AutoLISP. Задание следующее: построить шесть правильных шестигранников с центрами, равномерно расположенными на окружности с заданным центром и радиусом или диаметром. Пыталась написать хоть что-то. Вот что получилось:
Код:
[Выделить все]
 (  defun c:lab()
        (setq p (getpoint "\nStart point :"))
        (setq rad (getreal p "\nRadius :"))
        (setq num (getint "\nColor :"))
        (command "COLOR" num)
        (command "CIRCLE" p rad)
  	(setq p1 (getpoint "Choose a point on a circle"))
  	(setq p2 (polar p1 (/ pi 3) rad))
	(setq p3 (polar p2 (/ pi 3) rad))
	(setq p4 (polar p3 (/ pi 3) rad))
	(setq p5 (polar p4 (/ pi 3) rad))
	(setq p6 (polar p5 (/ pi 3) rad))
	(setq R (/ rad 3))
	(command "CIRCLE" p1 R)
	(command "CIRCLE" p2 R)
	(command "CIRCLE" p3 R)
	(command "CIRCLE" p4 R)
	(command "CIRCLE" p5 R)
	(command "CIRCLE" p6 R)
)
Для начала взяла шесть окружностей вместо шестигранников, но, видимо, даже здесь смогла допустить ошибки. Подскажите, пожалуйста, как лучше выполнить задание лабораторной работы.
Просмотров: 845
 
Непрочитано 07.11.2018, 17:38
#2
RrRR


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


Код:
[Выделить все]
 (getreal p "\nRadius :")
Так точно работает? Зачем параметр p?
и потом у вас точки каждый раз вычисляются от предыдущей (через polar) - в результате объекты выстроятся по лесенке.
Возможно получится если для точек центров второстепенных объектов опираться на центр большой окружности.
RrRR вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 07.11.2018, 17:53
#3
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,674


Цитата:
Сообщение от RrRR Посмотреть сообщение
(getreal p "\nRadius :")

Так точно работает? Зачем параметр p?
Девушка, видимо, хотела написать (getdist p "\nRadius :")
Для itshpit
Создай нужный шестиугольник, преврати его в блок, подели исходную окружность на 6 частей, в точки деления вставь этот блок.
Profan вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 08.11.2018, 08:28
#4
Кулик Алексей aka kpblc
Moderator

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


Пока работать неохота:
Код:
[Выделить все]
 (vl-load-com)

(defun c:lab (/ adoc center rad ang step base p_rad)
  (if (and (= (type
                (setq center (vl-catch-all-apply (function (lambda () (getpoint "\nCenter point <Cancel> : ")))))
                ) ;_ end of type
              'list
              ) ;_ end of =
           center
           (= (type (setq rad (vl-catch-all-apply (function (lambda () (getdist center "\nRadius <Cancel> : ")))))
                    ) ;_ end of type
              'real
              ) ;_ end of =
           ) ;_ end of and
    (progn (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
           (setq ang   0.
                 step  (/ pi 3.)
                 p_rad (/ (/ rad 2.) (cos (/ pi 6.)))
                 ) ;_ end of setq
           (entmakex (list (cons 0 "circle") (cons 10 center) (cons 40 rad)))
           (while (< ang (* pi 2.))
             (setq base (polar center ang rad))
             (entmakex
               (append (list '(0 . "lwpolyline") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 6) '(70 . 1))
                       ((lambda (/ _lst _a)
                          (setq _a 0.)
                          (while (< _a (* pi 2.))
                            (setq _lst (cons (polar base (+ _a (/ pi 6.)) p_rad) _lst)
                                  _a   (+ _a step)
                                  ) ;_ end of setq
                            ) ;_ end of while
                          (mapcar (function (lambda (x) (cons 10 (list (car x) (cadr x))))) _lst)
                          ) ;_ end of lambda
                        )
                       ) ;_ end of append
               ) ;_ end of entmakex
             (setq ang (+ ang step))
             ) ;_ end of while
           (vla-endundomark adoc)
           ) ;_ end of progn
    ) ;_ end of if
  (princ)
  ) ;_ end of defun
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 09.11.2018, 12:02
#5
koMon


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


Offtop:
Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Пока работать неохота:
сдаётся мне, что это выходит за рамки лабораторной работы)
koMon вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 09.11.2018, 12:23
#6
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,645
Отправить сообщение для Do$ с помощью Skype™


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Пока работать неохота:
Вот это подстава так подстава! А если препод попросит объяснить как это работает?
__________________
Толковый выбор приходит с опытом, а к нему приводит выбор бестолковый. (The Mechanic)
Do$ вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 09.11.2018, 12:49
#7
Кулик Алексей aka kpblc
Moderator

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


Offtop: "Как" - ладно. А вот "почему это так написано" - это уже значительно интереснее
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 09.11.2018, 12:51
#8
Сергей812


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


Offtop:
Цитата:
Сообщение от Do$ Посмотреть сообщение
Вот это подстава так подстава! А если препод попросит объяснить как это работает?
дать ссылку на эту ветку - проблем то)
Сергей812 вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 09.11.2018, 13:16
1 | #9
Кулик Алексей aka kpblc
Moderator

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


Чисто для поржать:
Код:
[Выделить все]
 (vl-load-com)

(defun c:lab2 (/ adoc center rad ang step base p_rad range)
  (if (and (= (type
                (setq center (vl-catch-all-apply (function (lambda () (getpoint "\nCenter point <Cancel> : ")))))
                ) ;_ end of type
              'list
              ) ;_ end of =
           center
           (= (type (setq rad (vl-catch-all-apply (function (lambda () (getdist center "\nRadius <Cancel> : ")))))
                    ) ;_ end of type
              'real
              ) ;_ end of =
           (= (type (setq range (vl-catch-all-apply
                                  (function (lambda ()
                                              (max 3
                                                   (cond (((lambda () (initget 6) (getint "\nEnter range <6> : "))))
                                                         (t 6)
                                                         ) ;_ end of cond
                                                   ) ;_ end of max
                                              ) ;_ end of lambda
                                            ) ;_ end of function
                                  ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'int
              ) ;_ end of =
           ) ;_ end of and
    (progn (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
           (setq ang   0.
                 step  (/ (* 2 pi) range)
                 p_rad (/ (/ rad 2.) (cos (/ pi range)))
                 ) ;_ end of setq
           (entmakex (list (cons 0 "circle") (cons 10 center) (cons 40 rad)))
           (while (< ang (* pi 2.))
             (setq base (polar center ang rad))
             (entmakex
               (append (list '(0 . "lwpolyline") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 range) '(70 . 1))
                       ((lambda (/ _lst _a)
                          (setq _a 0.)
                          (while (< _a (* pi 2.))
                            (setq _lst (cons (polar base (+ _a (/ pi range)) p_rad) _lst)
                                  _a   (+ _a step)
                                  ) ;_ end of setq
                            ) ;_ end of while
                          (mapcar (function (lambda (x) (cons 10 (list (car x) (cadr x))))) _lst)
                          ) ;_ end of lambda
                        )
                       ) ;_ end of append
               ) ;_ end of entmakex
             (setq ang (+ ang step))
             ) ;_ end of while
           (vla-endundomark adoc)
           ) ;_ end of progn
    ) ;_ end of if
  (princ)
  ) ;_ end of defun
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 09.11.2018, 13:34
#10
Сергей812


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


комментариев в коде маловато - не сдаст, имхо)
Сергей812 вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 09.11.2018, 13:48
#11
Кулик Алексей aka kpblc
Moderator

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


Offtop: Нормально! Почти в каждой строчке
Все, теперь ждем ТС. Лично я сюда коды писать уже не стану.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 09.11.2018, 14:18
1 | 1 #12
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,645
Отправить сообщение для Do$ с помощью Skype™


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Чисто для поржать:
Ну я не знаю, примут ли такое:
- инсталлятора нет
- локализации нет
- справочная система отсутствует
- нет partial cuix для размещения кнопки на ленте и на панельках
- нет настроек создаваемых объектов: цвет, слой, тип линии, вес линии
- не выложено в Autodesk AppStore...
В общем, куча недостатков

----- добавлено через ~6 мин. -----
Цитата:
Сообщение от Сергей812 Посмотреть сообщение
дать ссылку на эту ветку - проблем то)
Offtop: Думаю, если препод толковый - он сам найдёт эту тему. Форум-то известный. Ну или создаст рядом тему "Помогите понять как это работает: принесла студентка, не могу разобраться, но вроде работает"
__________________
Толковый выбор приходит с опытом, а к нему приводит выбор бестолковый. (The Mechanic)
Do$ вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 09.11.2018, 14:38
#13
Кулик Алексей aka kpblc
Moderator

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


Цитата:
Сообщение от Do$ Посмотреть сообщение
Ну я не знаю, примут ли такое:
- инсталлятора нет
- локализации нет
- справочная система отсутствует
- нет partial cuix для размещения кнопки на ленте и на панельках
- нет настроек создаваемых объектов: цвет, слой, тип линии, вес линии
- не выложено в Autodesk AppStore...
А че, реально надо? ))
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 09.11.2018, 14:50
#14
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,645
Отправить сообщение для Do$ с помощью Skype™


Да навряд ли, конечно. Но если бы я был преподом и увидел так выполненное задание, то именно так бы придирался
__________________
Толковый выбор приходит с опытом, а к нему приводит выбор бестолковый. (The Mechanic)
Do$ вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 09.11.2018, 15:07
#15
Сергей812


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


Когда в свое время были лабораторные на паскале на первом курсе вуза - просто преподавательница тыкала в любую строчку написанного студентом кода и просила рассказать, что именно делается в коде с этого места. Срезались сразу, даже с заученным общим текстом)
Сергей812 вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 14.11.2018, 14:35
1 | #16
koMon


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


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Пока работать неохота:
поддержу, с динамикой

Код:
[Выделить все]
 
;*************************************************************************************************************************

(vl-load-com)

;*************************************************************************************************************************

(defun draw_hex_circle (parsed_point_1 parsed_center_point parsed_modelspace_object parsed_hex_circle_exist / p1_angle p1_distance hex_coordinates_array hex_coordinates_list array_index hex_index hex_center_point)
    (setq p1_angle (angle parsed_center_point parsed_point_1)
		  p1_distance (distance parsed_center_point parsed_point_1)
	)
	(setq hex_index 1)
	(repeat 6
		(setq hex_center_point (polar parsed_center_point (+ (* (1- hex_index) (/ pi 3.0)) p1_angle) p1_distance))
		(set (read (strcat "hex_" (itoa hex_index) "_coordinates_array")) (vlax-make-safearray vlax-vbDouble '(0 . 17)))
		(setq array_index 0)
		(repeat 6
			(vlax-safearray-put-element (eval (read (strcat "hex_" (itoa hex_index) "_coordinates_array"))) (* 3 array_index) (car (polar hex_center_point (+ (* array_index (/ pi 3)) (- p1_angle (/ pi 6))) (/ (* 0.5 p1_distance) (cos (/ pi 6))))))
			(vlax-safearray-put-element (eval (read (strcat "hex_" (itoa hex_index) "_coordinates_array"))) (1+ (* 3 array_index)) (cadr (polar hex_center_point (+ (* array_index (/ pi 3)) (- p1_angle (/ pi 6))) (/ (* 0.5 p1_distance) (cos (/ pi 6))))))
			(setq array_index (1+ array_index))
		)
		(setq hex_index (1+ hex_index))
	)
	(if (null parsed_hex_circle_exist)
		(if (null (zerop p1_distance))
			(progn
    			(setq circle_object (vla-addCircle parsed_modelSpace_object (vlax-3d-point parsed_center_point) p1_distance)
					  hex_index 1
				)
				(repeat 6
					(set (read (strcat "hex_" (itoa hex_index) "_Object")) (vla-AddPolyline parsed_modelSpace_object (eval (read (strcat "hex_" (itoa hex_index) "_coordinates_array")))))
					(vla-put-closed (eval (read (strcat "hex_" (itoa hex_index) "_Object"))) :vlax-true)
					(setq hex_index (1+ hex_index))
				)
				(setq hex_circle_exist t)
			)
		)
		(if (null (zerop p1_distance))
			(progn
				(vla-put-radius circle_Object p1_distance)
				(setq hex_index 1)
				(repeat 6
    				(vla-put-coordinates (eval (read (strcat "hex_" (itoa hex_index) "_Object"))) (eval (read (strcat "hex_" (itoa hex_index) "_coordinates_array"))))
					(setq hex_index (1+ hex_index))
				)
			)
		)
	)
)

;*************************************************************************************************************************

(defun c:6_Hex_on_Circle ( / modelSpace_object center_point getting_point_1 hex_circle_exist error_ocurred gread_data point_1 hex_index)
	(setq modelSpace_object (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
		  center_point (getpoint "\nУкажите центр окружности: ")
		  getting_point_1 t
		  hex_circle_exist nil
	)
	(prompt "\nУкажите радиус круга: ")
	(while getting_point_1
		(setq error_ocurred (if (vl-catch-all-error-p (setq gread_data (vl-catch-all-apply 'grread (list t 8 0)))) t nil))
    	(cond
			(
				error_ocurred
					(prompt "\nНеверно!")
			)
			(
			   	(= 25 (car gread_data))				;Mouse Right Click
					(setq point_1 (getpoint center_point "\rУкажите радиус круга: ")
						  getting_point_1 nil
					)
					(draw_hex_circle point_1 center_point modelspace_object hex_circle_exist)
			)
			(
			   	(= 5 (car gread_data))				;Mouse Moving
					(draw_hex_circle (cadr gread_data) center_point modelspace_object hex_circle_exist)
			)
			(
				(or
					(equal gread_data (quote (2 32)))		;Space
					(equal gread_data (quote (2 13)))     	;Enter
					(= 3 (car gread_data))				    ;Mouse Left Click
				)
					(setq getting_point_1 nil)

			)
			(
			 	t
					(prompt "\nНеверно!")
			)
		)
	)
	(vlax-release-object circle_object)
	(setq circle_object nil
		  hex_index 1
	)
	(repeat 6
		(vlax-release-object (eval (read (strcat "hex_" (itoa hex_index) "_Object"))))
		(set (read (strcat "hex_" (itoa hex_index) "_Object")) nil)
		(set (read (strcat "hex_" (itoa hex_index) "_coordinates_array")) nil)
		(setq hex_index (1+ hex_index))
	)
	(princ)
)

;*************************************************************************************************************************
koMon вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 14.11.2018, 18:00
#17
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,645
Отправить сообщение для Do$ с помощью Skype™


Цитата:
Сообщение от koMon Посмотреть сообщение
поддержу, с динамикой
Так-так-так, а почему по Esc нет прерывания? Незачёт!
__________________
Толковый выбор приходит с опытом, а к нему приводит выбор бестолковый. (The Mechanic)
Do$ вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 15.11.2018, 00:59
#18
itshpit


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


Код выполнен. Кому интересно, что в итоге вышло:
Код:
[Выделить все]
 (defun c:lab (/ ) 
(setq p1 (getpoint "Укажите центр окружности.")) 
(setq R (getdist p1 "Укажите радиус.")) 
(command "ЦВЕТ" 1 "") 
(command "_circle"  p1  R "") 
(setq p2 (polar p1 0 R)) 
(command "ЦВЕТ" 2 "") 
(command "_polygon" 6  p2 "В" (/ R 3)  "") 
(setq fi 0) 
(setq dfi (/ pi 3)) 
(setq n 2) 
(repeat 5 
  (setq osm (getvar "osmode")) 
  (setvar "osmode" 0) 
  (setq fi (+ fi dfi)) 
  (setq p3 (polar p1 fi R)) 
  (setq n (+ n 1)) 
  (command "ЦВЕТ" n "") 
  (command "_polygon" 6  p3 "В" (/ R 3)  "") 
)
)
itshpit вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 15.11.2018, 07:04
#19
Кулик Алексей aka kpblc
Moderator

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


1. Ориентировано на русский ACAD. В английской версии работать не будет.
2. Здрасьте, грабли.
3. Переменные не восстанавливаются.
4. ...
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 15.11.2018, 09:18
#20
koMon


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


Цитата:
Сообщение от Do$ Посмотреть сообщение
Так-так-так, а почему по Esc нет прерывания? Незачёт!
так это ведь лабортооооооорка
koMon вне форума вставить имя Обратить внимание модератора на это сообщение  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Помогите с лабораторной по AutoLISP (построить 6 шестригранников на окружности)

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

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

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Какой язык перспективен для инженера-конструктора с условием The_Mercy_Seat Программирование 669 24.03.2017 20:16
Помогите пожалуйста построить розу ветров для г.Жигулевск. везде написано что по СНиП Строит. климатология, но я там ничего не нашел. Очень нужно, для Серега 5577 Поиск литературы, чертежей, моделей и прочих материалов 24 27.06.2012 14:09
Пожалуйста помогите построить аксонометрию... nizamiev-ilnur Разное 31 11.04.2012 21:11
Помогите студенту с AutoLISP Микс LISP 11 24.11.2007 23:19

|| Главная || Каталог САПР || Тендеры || Публикации || Объявления || Биржа труда || Download || Галерея ||
|| Библиотека || Кунсткамера || Каталог предприятий || Контакты || Файлообменник || Блоги ||