[Red Nova]

Со школы не ладится у меня с программированием. Все предметы щелкал, а на экзамене по информатике (Visual foxpro) программку типа суммирования столбцов списал у соседа (это уже в университете).
Не смотря на эте намерен научится писать программы для Автокада на лиспе, скачал книгу Хювенена, несколько примеров создания программ, но после получасового “смотрения” таких книг мое мышление явно притормаживает.
Решил пойти другим путем.
Нашел самый короткий лисп из моей коллекции, и прошу программистов с этого форума пошагово объяснить какой символ что означает. Надеюсь на вашу помощь.

Код:

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

(defun c:make-blocks-explodeable (/ adoc)
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (vlax-for blk_def (vla-get-blocks adoc)
    (if (and (equal (vla-get-isxref blk_def) :vlax-false)
             (equal (vla-get-islayout blk_def) :vlax-false)
             ) ;_ end of and
      (vl-catch-all-apply '(lambda () (vla-put-explodable blk_def :vlax-true)))
      ) ;_ end of if
    ) ;_ end of vlax-for
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

_____________________________________________________________________________________________________________

Прошло много лет и топик теперь представляет из себя площадку для обучения азов программирования для многих начинающих.
Так что начинающие лиспогрызы приветствуются .

[alex8888]

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

Вроде бы проходит, только с именем файла я помудрю - пока пишется с двойным расширением (*.dwg.dxf)
Что касаемо самого процесса, то опять темный лес. И почему я такой тупой
Что происходит в этой строке: (cons 0 (1- (vla-get-count vla_selset))) ?
В книге Полещука выглядит так: (vla-copyobjects <объекты - БМ объектов> [<владелец - vla-объект места назначения>] [<пары клонирования - переменная в которой массив пар клонирования>]).
А что у нас:

Код:

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

(vla-copyobjects		;Клонирование объектов в другой док-т, блок или пр-во
	    adoc			;текущий документ
	    (vlax-safearray-fill	;заполнение бм
	      (vlax-make-safearray	;создание бм
		vlax-vbobject		;тип данных бм - vbobject
		(cons 0 (1- (vla-get-count vla_selset)))    ;- что это?
	      ) ;_ end of vlax-make-safearray
	      ((lambda (/ lst)                     ;это тоже темный лес
		 (vlax-for ent vla_selset
		   (setq lst (cons ent lst))
		 ) ;_ end of vlax-for
	       ) ;_ end of lambda
	      )
	    ) ;_ end of vlax-safearray-fill
	    (vla-get-modelspace doc_to_save)
	  ) ;_ end of vla-CopyObjects

Думал про себя что проще будет в Активах-Х разбираться.

Не понравилось. Когда вручную открываешь документ, сохраняешь как dxf последней модели (R12), то при последующем открытии его для предпросмотра - все, что вручную выбирал видно в окне, а когда все тоже но через твою программу - то видно пустое поле, а выбранные элементы спрятаны где-то за пределами экрана. Грешу на привязку к системам координат (уж больно похоже, что показывается та часть, которая топчется около центра МСК) Можно как то изменить?

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

Сообщение от alex8888 Что происходит в этой строке: (cons 0 (1- (vla-get-count vla_selset))) ?

Задается размер безопасного массива.

Код:

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

(vla-copyobjects ;Клонирование объектов в другой док-т, блок или пр-во
  adoc    ; указатель, откуда копируем - текущий документ
  (vlax-safearray-fill ;заполнение бм
    (vlax-make-safearray ;создание бм
      vlax-vbobject ;тип данных бм - vbobject
      (cons 0 (1- (vla-get-count vla_selset))) ; размерность безопасного массива
      ) ;_ end of vlax-make-safearray
    ((lambda (/ lst) ; преобразование полученного через ActiveX набора в список
       ; Дело в том, что в safearray можно передавать только список элементов,
       ; и никак иначе.
       (vlax-for ent vla_selset
         (setq lst (cons ent lst))
         ) ;_ end of vlax-for
       ) ;_ end of lambda
     )
    ) ;_ end of vlax-safearray-fill
  (vla-get-modelspace doc_to_save) ; указатель на "получателя"
  ; То есть пространство модели добавленного документа.
  ) ;_ end of vla-CopyObjects

[alex8888]

Кулик Алексей aka kpblc, теперь все встало на свои места
А то голову сломал в этих ухищрениях.

Как насчет:

Когда вручную открываешь документ, сохраняешь как dxf последней модели (R12), то при последующем открытии его для предпросмотра - все, что вручную выбирал видно в окне, а когда все тоже но через твою программу - то видно пустое поле, а выбранные элементы спрятаны где-то за пределами экрана. Грешу на привязку к системам координат (уж больно похоже, что показывается та часть, которая топчется около центра МСК) Можно как то изменить?

Алексей, поясни пожалуйста как понять: (setq lst (cons ent lst)). Присвоение переменной lst (список, как я понял) точечной пары из символа ent и той же переменной? Какова роль символа ent?

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

Скажу честно - я код гонял только на предмет "работает / не работает". Попробую посмотреть, но результат гарантировать не могу.

[alex8888]

Прошу помощи опять
Хочу скопировать объекты определенного фильтра (в данном случае со слоя 0) и вставить сюда же, но где то рядом.
Что пропустил в vla-copyobjects или неправильно сделал. До точки "до сюда функция дошла" - все в порядке, а дальше посылают ...

Код:

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

(defun begin_activex (/)
  
  (vl-load-com)				;Загрузка расширенний VLisp
  
  (setq acad_application (vlax-get-acad-object))
  					;док-т Автокада
  (setq active_document (vla-get-ActiveDocument acad_application))
					;активный док-т Автокада
  (setq model_space (vla-get-modelspace active_document))
					;пр-во модели активного док-та
  (setq paper_space (vla-get-paperspace active_document))
					;пр-во листа активного док-та

)					;defun
(defun at_select_objects_to_copy
       ( /
	selsets ss_name
;;;	vla_selset doc_to_save
	)
  
  (begin_activex)

  (setq selsets	(vla-get-selectionsets active_document)	;указатель на семейство наборов
	ss_name	"wb"				;имя для набора
  ) ;_ end of setq

  (vl-catch-all-apply		;ловля ошибок
	(function
	  (lambda ()
	    (vla-delete (vla-item selsets ss_name))	;удалить объект selsets с именем ss_name из раннего набора, если таковой был
	  ) ;_ end of lambda
	) ;_ end of function
      ) ;_ end of vl-catch-all-apply

  (setq vla_selset			;присвоить
	     (vla-add			;vla-
	       selsets			;набору
	       ss_name			;имя
	       );vla-add
	    );setq

  (if
   (and			;и см. vla-get-count (число выбранных элементов не нулевое)
	    (not			;не
		 (vl-catch-all-error-p	;равна ошибке (не возвращается объект типа ошибки)
		      (vl-catch-all-apply	;ловля ошибок
			
			(function		;создание бм - безопасных массивов
			  (lambda (/ group data) ;Выборка по условию
			    (setq group	(vlax-make-variant	;создание варианта
					  (vlax-safearray-fill  ;заполнение бм
					    (vlax-make-safearray;создание бм
					      vlax-vbinteger	;тип данных бм - целые числа
					      '(0 . 0)		;размерность массива (не определенный)
					    ) 			;_ end of vlax-make-safearray
					    '(8)		;заполнение бм (8- dxf код слоя (Layer))
					  ) ;_ end of vlax-safearray-fill
					);_ end of vlax-make-variant
				  
				  data	(vlax-make-variant	;создание варианта
					  (vlax-safearray-fill  ;заполнение бм
					    (vlax-make-safearray;создание бм
					      vlax-vbvariant	;тип данных бм - неопределенные значения
					      '(0 . 0)		;размерность массива (не определенный)	
					    ) 			;_ end of vlax-make-safearray
					    '("0");заполнение бм (перечисление названий уровней(слоев))
								;'("ИменаСлоев,ЧерезЗапятую")
					  );_ end of vlax-safearray-fill
					);_ end of vlax-make-variant
			    );_ end of setq
			    
			    (vla-selectonscreen			;интерактивный выбор графических объектов (без group и data выберет всё)
			      vla_selset 			;объект документа
			      group				;бм цел.чисел в виде варианта (фильтр по типу)
			      data				;бм с данными типа "вариант" (данные фильтра)
			    ) 			;_end of vla-selectOnScreen		
			  ) 			;_ end of lambda
			) 			;_ end of function
		      ) 		;_ end of vl-catch-all-apply
		    ) 			;_ end of vl-catch-all-error-p
	       ) 		;_ end of not
	    
	       (>			;2-е условие для "если Да" - число выбранных элементов не ничего
		 (vla-get-count vla_selset) 0) 	;число выбранных объектов не равно 0 (что то выбрано)
	  );and
   (
    (progn
      (alert "До сюда функция дошла")
      
      (vla-copyobjects			;Клонирование объектов в другой док-т, блок или пр-во
  active_document			; указатель, откуда копируем - текущий документ
  (vlax-safearray-fill			;заполнение бм
    (vlax-make-safearray		;создание бм
      vlax-vbobject			;тип данных бм - vbobject
      (cons 0 (1-			;создание точечной пары (0 . (число_элементов -1, потому что считается от 0))
		(vla-get-count		;получение числа объектов (элементов)
		  vla_selset)))		;объект
					; размерность безопасного массива
    ) ;_ end of vlax-make-safearray

    
    ((lambda (/ lst)			; преобразование полученного через ActiveX набора в список
					; Дело в том, что в safearray можно передавать только список элементов,
					; и никак иначе.
       (vlax-for			;Вычисляет выражение со всеми объектами семейства
		 ent			;символ, вместо которого в выражения нужно поочередно подставлять объекты семейства
		 vla_selset		;VLA-объект, соответствующий семейству, к объектам которого применяются выражения
	 (setq lst (cons ent lst))	;составление списка из VLA-объектов
       ) ;_ end of vlax-for
     ) ;_ end of lambda
    )
  ) ;_ end of vlax-safearray-fill
  model_space	; указатель на "получателя"
					; То есть пространство модели 
)
;;;    (vla-copy vla_selset)
    );progn
    );if true
   (alert "Function abort!"
    );if false
  );if
  
  );defun

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

Это не сработает. Если надо копировать "рядом", не меняя пространство-владелец, то (если не прибегать, например, к командным методам), то проще будет воспользоваться командами vla-copy и vla-move - именно так, сначала одно, потом второе. Причины объяснены в справке, да и так видны
Я не рассматриваю вариант "прочитать все примитивы, пересчитать все точки, построить примитивы заново".

[alex8888]

Алексей,
vla-copyobjects - клонирование объектов в:
1. другой файл,
2. другое пространство,
3. блок. <- это подходит для копирования объектов и последующей их вставки в текущее же пространство, файл, чертеж? Или это что-то другое? Можно ли создать блок, перенести его и расчленить? Или это работа через ж...?

Набрал в предыдущий лисп (vla-copy vla_selset) , меня послали : VLA-OBJECT nil. Какой объект ему нужен? Я правильно понял, что в vla_selset у меня набор отфильтрованных элементов (выборка), или это только указатель на них, или это одно и тоже?

Какова должна быть последовательность действий? 1. vla-copy выбираемых объектов - они должны быть сохранены в какой-то переменной?
2. vla-move - указать 2 точки -откуда и куда переместить?

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

Ну ты ета... Короче, не того. И не этого

Код:

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

(vl-load-com)

(defun test (/ fun_create-variant adoc ss_name ss_vla copy_res pt_base pt_end)

  (defun fun_create-variant (datas data-type)
    (vlax-make-variant
      (vlax-safearray-fill (vlax-make-safearray data-type (cons 0 (1- (length datas)))) datas)
      ) ;_ end of vlax-make-variant
    ) ;_ end of defun

  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (setq ss_name "wb")
  (vl-catch-all-apply
    (function
      (lambda ()
        (vla-delete (vla-item (vla-get-selectionsets adoc) ss_name))
        ) ;_ end of lambda
      ) ;_ end of function
    ) ;_ end of vl-catch-all-apply
  (setq ss_vla (vla-add (vla-get-selectionsets adoc) ss_name))
  (if (and (not (vl-catch-all-error-p
                  (vl-catch-all-apply
                    (function
                      (lambda (/ group data)
                        (setq group (fun_create-variant '(8) vlax-vbinteger)
                              data  (fun_create-variant '("0") vlax-vbvariant)
                              ) ;_ end of setq
                        (vla-selectonscreen ss_vla group data)
                        ) ;_ end of lambda
                      ) ;_ end of function
                    ) ;_ end of vl-catch-all-apply
                  ) ;_ end of vl-catch-all-error-p
                ) ;_ end of not
           (> (vla-get-count ss_vla) 0)
           (= (type (setq pt_base (vl-catch-all-apply
                                    (function
                                      (lambda ()
                                        (getpoint "\nBase point <Cancel> : ")
                                        ) ;_ end of lambda
                                      ) ;_ end of function
                                    ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'list
              ) ;_ end of =
           (= (type (setq pt_end (vl-catch-all-apply
                                   (function
                                     (lambda ()
                                       (getpoint pt_base "\End point <Cancel> : ")
                                       ) ;_ end of lambda
                                     ) ;_ end of function
                                   ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'list
              ) ;_ end of =
           (setq pt_base (vlax-3d-point pt_base)
                 pt_end  (vlax-3d-point pt_end)
                 ) ;_ end of setq
           ) ;_ end of and
    (progn
      (foreach ent 
;; Каждый из объектов копируем
(mapcar
                     (function
                       (lambda (x)
                         (vla-copy x)
                         ) ;_ end of lambda
                       ) ;_ end of function
;;; Преобразование набора в список примитивов
                     ((lambda (/ res)
                        (vlax-for ent ss_vla
                          (setq res (cons ent res))
                          ) ;_ end of vlax-for
                        res
                        ) ;_ end of lambda
                      )
                     ) ;_ end of mapcar
;; А теперь переносим копии
(vla-move ent pt_base pt_end)
        ) ;_ end of foreach
      ) ;_ end of progn
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)

  ) ;_ end of defun

[alex8888]

Кулик Алексей aka kpblc, вот это оперативность!
Только мне теперь опять неделю надо обсасывать твой код
Как все-таки кардинальным образом меняется код только лишь от изменения крохотного условия задачи
Спасибо.

Алексей, код работает на ура.

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

Ни фига себе - "крохотного"... Есть принципиальная разница между копированием объектов между владельцами и копированием объектов внутри одного владельца.
Кстати, все вот это можно заменить элементарным:

Код:

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

(command "_.copy")
(while (/= (getvar "cmdactive") 0)
(command pause))

Вроде так...

[alex8888]

Я в шоке!

Но, в этом случае выбирать приходится вручную, можно попросту скопировать ненужное и упустить важное. Т.е. мне важнее все-таки отфильтрованные значения.

Не знал, что копирование со сменой владельца и просто копирование это сильно разные вещи. Ведь там копирование и там, Ctrl+C + Ctrl+V работают одинаково. А тут такие страшности! Я уж подумал, что ты просто не хочешь меня подпустить к объектному методу программирования , поэтому и меняешь код почти на 100%

Маленький вопросик (просьбочка ): а можно сделать в твоем лиспе так, чтобы скопированные объекты "висели" на курсоре, как при штатном копировании-вставке, а то неудобно - не видно куда вставляешь?

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

Лиспом это слишком геморройно. Если коротко, то надо а) создавать анонимный блок и б) искать тему "На заметку программистам" и брать оттуда готовые коды.

[alex8888]

Алексей, понятно. Спасибо.

Кулик Алексей aka kpblc, а командными методами получилось проще:

Код:

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

(defun at_copy_paste ()			;определение функции, переменных нет

  (command)				;прерывает действие любой неоконченной команды

  (command "_.copy" (ssget '((8 . "0,Schrift"))) "")
					;копирует выбор со слоев 0 и Schrift

)					;defun

[gomer]

Прошу прощения за глупый вопрос... Но в чем разница

Сообщение от Кулик Алексей aka kpblc Код: [Выделить все] (defun test (/ fun_create-variant adoc ss_name ss_vla copy_res pt_base pt_end) (defun fun_create-variant (datas data-type) (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray data-type (cons 0 (1- (length datas)))) datas) ) ;_ end of vlax-make-variant ) ;_ end of defun .......

и

Код:

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

(defun test (/ fun_create-variant adoc ss_name ss_vla copy_res pt_base pt_end)

 (setq
  fun_create-variant
  (lambda (datas data-type)
    (vlax-make-variant
      (vlax-safearray-fill (vlax-make-safearray data-type (cons 0 (1- (length datas)))) datas)
    ) ;_ end of vlax-make-variant
  )
)
    .......

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

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

[alex8888]

Кулик Алексей aka kpblc, пожалуйста посмотри мой код ниже.
1. Проблема состоит в том, что у меня не получается объединить 2 полилинии в одну. Вручную они объединяются нормально.
2. Можно как-нибудь упростить расчет точек для сплайна или уменьшить их количество не в ущерб развертки?

Код:

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

;|****************************************************************************
*        Программа построения развертки отвода                               *
*    Пример вызова: (at_stutzen 200 100 300), где                            *
*                          200 - диаметр основной трубы                      *
*                          100 - диаметр отвода                              *
*                          300 - длина отвода                                *
*  Составлена 13.07.2010  Автор: Tutubalin Alexander                         *
****************************************************************************|;


(defun at_stutzen (
		   Kopf_D
		   Stutzen_D
		   Stutzen_hoehe
		   /
		   pt_input
		   m
		   pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10
		   pt11 pt12 pt13 pt14 pt15 pt16 pt17 pt18 pt19 pt20
		   pt21 pt22 pt23 pt24 pt25
		   m1 m2 m3 m4
		   otkat_pcm oldosm oldlay
		   spline1 rec poly
		   )
  
  (defun *error* (msg)
     (princ msg)				;text bei error
    (if	oldosm
      (setvar "OSMODE" oldosm)
    )					;if oldosm - zadano -> oldosm=oldosm
    (if	oldlay
      (setvar "CLAYER" oldlay)
    )					;if layer gewechselt -> zurueck
    (if otkat_pcm
      (setvar "plineconvertmode" otkat_pcm)

  )				;if
);error

					;Parametry privjazki

  (setq oldosm (getvar "osmode"))
  (setvar "osmode" 0)
  (setq oldlay (getvar "clayer"))
  (setq otkat_pcm (getvar "plineconvertmode"))
  (setvar "plineconvertmode" 1)


(if (< Kopf_D Stutzen_D)
  (progn
    (alert "\nKopf Durchmesser muss groesse als Stutzen Durchmesser sein")
    (exit)
    );progn
  );if

  (if (< Stutzen_hoehe (/ Kopf_D 2.0))
    (progn
    (alert "\nStutzen Hoehe muss laenge sein")
    (exit)
    );progn
  );if
    
(setq
  pt_input (getpoint "\nInsert point")
  m (/ (* pi Stutzen_D) 12.0)
	
  pt1 (polar pt_input 0 m)
  pt2 (polar pt1 0 m)
  pt3 (polar pt2 0 m)
  pt4 (polar pt3 0 m)
  pt5 (polar pt4 0 m)
  pt6 (polar pt5 0 m)
  pt7 (polar pt6 0 m)
  pt8 (polar pt7 0 m)
  pt9 (polar pt8 0 m)
  pt10 (polar pt9 0 m)
  pt11 (polar pt10 0 m)
  pt12 (polar pt_input 0 (* pi Stutzen_D))

  m1 (- Stutzen_hoehe (* 0.5 (sqrt (- (* Kopf_D Kopf_D) (* Stutzen_D Stutzen_D)))))
  m2 (- Stutzen_hoehe (* 0.5 (sqrt (- (* Kopf_D Kopf_D) (* 0.75 Stutzen_D Stutzen_D)))))
  m3 (- Stutzen_hoehe (* 0.5 (sqrt (- (* Kopf_D Kopf_D) (* 0.25 Stutzen_D Stutzen_D)))))
  m4 (- Stutzen_hoehe (* 0.5 Kopf_D))

  pt13 (polar pt12 (* 0.5 pi) m4)
  pt14 (polar pt11 (* 0.5 pi) m3)
  pt15 (polar pt10 (* 0.5 pi) m2)
  pt16 (polar pt9 (* 0.5 pi) m1)
  pt17 (polar pt8 (* 0.5 pi) m2)
  pt18 (polar pt7 (* 0.5 pi) m3)
  pt19 (polar pt6 (* 0.5 pi) m4)
  pt20 (polar pt5 (* 0.5 pi) m3)
  pt21 (polar pt4 (* 0.5 pi) m2)
  pt22 (polar pt3 (* 0.5 pi) m1)
  pt23 (polar pt2 (* 0.5 pi) m2)
  pt24 (polar pt1 (* 0.5 pi) m3)
  pt25 (polar pt_input (* 0.5 pi) m4)

  
  );setq


  
  (vl-cmdf "_spline" pt13 pt14 pt15 pt16 pt17 pt18 pt19 pt20 pt21 pt22 pt23 pt24 pt25 "" "" "")
	(setq spline1 (entlast)) ;setq spline1
    
  (vl-cmdf "_splinedit" spline1 "_p" "10")
  	(setq poly (entlast))

  (vl-cmdf "_pline" pt25 pt_input pt12 pt13 "")
	(setq rec (entlast))

  (vl-cmdf "_pedit" "_join" poly rec "")
    
  
  (setvar "osmode" oldosm)
  (setvar "clayer" oldlay)
  (setvar "plineconvertmode" otkat_pcm)

  (princ)

  
  );defun

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

alex8888, с точками я не стал разбираться. А объединение попробуй так:

Код:

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

(vl-cmdf "_pedit" "_m" poly rec "" "_j" 0. "_close" "")

[alex8888]

Кулик Алексей aka kpblc, наверное, с точками ничего не поделаешь - там массив должен быть большой.

С объединением я решил по-другому: изменения в коде:

Код:

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

  pta (polar pt12 0 m)
  ptb (polar pta 0 m)
  ptc (polar ptb 0 m)
  ptd (polar pt_input pi m)
  pte (polar ptd pi m)
  ptf (polar pte pi m)

  pt26 (polar ptd (* 0.5 pi) m3)
  pt27 (polar pte (* 0.5 pi) m2)
  pt28 (polar ptf (* 0.5 pi) m1)
  pt29 (polar pta (* 0.5 pi) m3)
  pt30 (polar ptb (* 0.5 pi) m2)
  pt31 (polar ptc (* 0.5 pi) m1)

  ptm (polar pt6 (* 0.5 pi) (/ m4 2))




  
  );setq


  
  (vl-cmdf "_spline" pt31 pt30 pt29 pt13 pt14 pt15 pt16 pt17 pt18 pt19 pt20 pt21 pt22 pt23 pt24 pt25 pt26 pt27 pt28 "" "" "")
	(setq spline1 (entlast)) ;setq spline1
    
  (vl-cmdf "_splinedit" spline1 "_p" "10")
  	(setq poly (entlast))

  (vl-cmdf "_pline" pt25 pt_input pt12 pt13 "")
	(setq rec (entlast))

;;;  (vl-cmdf "_pedit" "_join" poly rec "")

  (vl-cmdf "_-boundary" ptm "")

  (vl-cmdf "_erase" poly "")
  (vl-cmdf "_erase" rec "")

Пришлось ввести еще 13 точек, потому что сплайн неверно обрабатывал края развертки. Получились "усы" в обе стороны.
Единственное, что boundary что то долго просчитывает у себя в уме (секунд 3-5), но это не смертельно.

[alex8888]

Помогите пожалуйста немного с оптимизацией.
Произвожу расчет координат по горизонтали (L) и по вертикали (H) для построения кривой опираясь на координаты базовой точки, задаваемой извне (здесь - пользователем):

Код:

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

(setq 	pt_insert (getpoint "\nInput start_point")
			
			spisok_sin (mapcar 'sin (list 0 (/ pi 8.0) (/ pi 4.0) (* 3.0 (/ pi 8.0)) (/ pi 2.0)))
			r2r (/ radius_stutzen radius_truba)
			
			L0 (sqrt (- (expt radius_stutzen 2.0) (* (expt (* radius_stutzen (nth 0 spisok_sin)) 2.0))))
			L1 (sqrt (- (expt radius_stutzen 2.0) (* (expt (* radius_stutzen (nth 1 spisok_sin)) 2.0))))
			L2 (sqrt (- (expt radius_stutzen 2.0) (* (expt (* radius_stutzen (nth 2 spisok_sin)) 2.0))))
			L3 (sqrt (- (expt radius_stutzen 2.0) (* (expt (* radius_stutzen (nth 3 spisok_sin)) 2.0))))
	  		L4 (sqrt (- (expt radius_stutzen 2.0) (* (expt (* radius_stutzen (nth 4 spisok_sin)) 2.0))))

	  		H0 (* radius_truba (at_arcsin (* r2r (nth 0 spisok_sin))))
	  		H1 (* radius_truba (at_arcsin (* r2r (nth 1 spisok_sin))))
	  		H2 (* radius_truba (at_arcsin (* r2r (nth 2 spisok_sin))))
	  		H3 (* radius_truba (at_arcsin (* r2r (nth 3 spisok_sin))))
			H4 (* radius_truba (at_arcsin (* r2r (nth 4 spisok_sin))))

	  		koordX (car pt_insert)
	  		koordY (cadr pt_insert)
 
			pt0 (list (+ koordX L0) (+ koordY H0) 0.0)
			pt1 (list (+ koordX L1) (+ koordY H1) 0.0)
			pt2 (list (+ koordX L2) (+ koordY H2) 0.0)
			pt3 (list (+ koordX L3) (+ koordY H3) 0.0)
			pt4 (list (+ koordX L4) (+ koordY H4) 0.0)
			pt5 (list (- koordX L3) (+ koordY H3) 0.0)
			pt6 (list (- koordX L2) (+ koordY H2) 0.0)
			pt7 (list (- koordX L1) (+ koordY H1) 0.0)
			pt8 (list (- koordX L0) (+ koordY H0) 0.0)
			pt9 (list (- koordX L1) (- koordY H1) 0.0)
			pt10 (list (- koordX L2) (- koordY H2) 0.0)
			pt11 (list (- koordX L3) (- koordY H3) 0.0)
			pt12 (list (- koordX L4) (- koordY H4) 0.0)
			pt13 (list (+ koordX L3) (- koordY H3) 0.0)
			pt14 (list (+ koordX L2) (- koordY H2) 0.0)
			pt15 (list (+ koordX L1) (- koordY H1) 0.0)
	)

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

Попробовал применить что то типа (strcat "L" (itoa i)) и (sqrt .... i...), где i - счетчик количества углов (синусов), используемых для построения, но не могу сделать переменную Li - она получается в виде "Li" и ее нельзя использовать например для setq

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

AtroksAlold, это ты про что?