| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

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

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

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

Здравствуйте. Никак не получается выполнить лабораторную по 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)
)
Для начала взяла шесть окружностей вместо шестигранников, но, видимо, даже здесь смогла допустить ошибки. Подскажите, пожалуйста, как лучше выполнить задание лабораторной работы.
Просмотров: 3474
 
Непрочитано 07.11.2018, 17:38
#2
RrRR


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


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


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


Цитата:
Сообщение от 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
С.-Петербург
Сообщений: 39,787


Пока работать неохота:
Код:
[Выделить все]
 (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
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 09.11.2018, 12:02
#5
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,665


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

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,702
Отправить сообщение для 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
С.-Петербург
Сообщений: 39,787


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


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


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

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


Чисто для поржать:
Код:
[Выделить все]
 (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
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 09.11.2018, 13:34
#10
Сергей812


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


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

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


Offtop: Нормально! Почти в каждой строчке
Все, теперь ждем ТС. Лично я сюда коды писать уже не стану.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 09.11.2018, 14:18
1 | 1 #12
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,702
Отправить сообщение для 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
С.-Петербург
Сообщений: 39,787


Цитата:
Сообщение от Do$ Посмотреть сообщение
Ну я не знаю, примут ли такое:
- инсталлятора нет
- локализации нет
- справочная система отсутствует
- нет partial cuix для размещения кнопки на ленте и на панельках
- нет настроек создаваемых объектов: цвет, слой, тип линии, вес линии
- не выложено в Autodesk AppStore...
А че, реально надо? ))
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 09.11.2018, 14:50
#14
Do$

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


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


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


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


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,665


Цитата:
Сообщение от Кулик Алексей 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,702
Отправить сообщение для 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
С.-Петербург
Сообщений: 39,787


1. Ориентировано на русский ACAD. В английской версии работать не будет.
2. Здрасьте, грабли.
3. Переменные не восстанавливаются.
4. ...
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 15.11.2018, 09:18
#20
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,665


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

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

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


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