Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)

Red Nova · 20.07.2008, 20:12

Со школы не ладится у меня с программированием. Все предметы щелкал, а на экзамене по информатике (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

_____________________________________________________________________________________________________________

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

mkung · Регистрация: 05.09.2007

Подскажите - как назначить объекту цвет RGB (например 40,87,130)?
Через свойство Color, я так понял, только индексные цвета.
Через свойства TrueColor и EntityColor - 32 разрядное число, которое не понятно как получить.
Чего-то не догоняю.

Прошу помощи.

Кулик Алексей aka kpblc · 26.05.2015, 09:49

Поищи по форуму - решения по преобразованию rgb в truecolor были. Во, пока отвечал, нашел:

Код:

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

 (defun _kpblc-conv-color-rgb-to-true (red green blue)
                                     ;|
*    Создание TrueColor-цвета на основе его RGB-представления
*    Параметры вызова:
  red  значение Red
  green  то же, Green
  blue  то же, Blue
|;
  (+ (lsh (fix (cond (red)
                     (t 0)
                     ) ;_ end of cond
               ) ;_ end of fix
          16
          ) ;_ end of lsh
     (lsh (fix (cond (green)
                     (t 0)
                     ) ;_ end of cond
               ) ;_ end of fix
          8
          ) ;_ end of lsh
     (lsh (fix (cond (blue)
                     (t 0)
                     ) ;_ end of cond
               ) ;_ end of fix
          ) ;_ end of lsh
     ) ;_ end of +
  ) ;_ end of defun

mkung · 26.05.2015, 11:40

За код спасибо!
Но все равно что-то не получается...

Код:

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

 (setq actdoc (vla-get-ActiveDocument (vlax-get-acad-object)) 
      vla_layer (vla-Item (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) "layer 1")
      vla_color (vla-GetInterfaceObject (vlax-get-acad-object) (strcat "Autocad.AcCmColor." (substr (getvar "ACADVER") 1 2)))
)
(setq tc (+ (lsh (fix (cond (40) 
                                   (t 0) 
                             ) ;_ end of cond 
                        ) ;_ end of fix 
                        16 
                   ) ;_ end of lsh 
                   (lsh (fix (cond (87) 
                                   (t 0) 
                             ) ;_ end of cond 
                        ) ;_ end of fix 
                        8 
                   ) ;_ end of lsh 
                   (lsh (fix (cond (130) 
                                   (t 0) 
                             ) ;_ end of cond 
                        ) ;_ end of fix 
                   ) ;_ end of lsh 
                )  
); end of setq
(vla-put-EntityColor vla_color tc)
(vla-put-TrueColor vla_layer vla_color)

(vla-put-EntityColor vla_color tc) выдает ; ошибка: Ошибка Automation. Отсутствует описание.

Вроде в примере у Полещука последние 2 строки так же написаны....
Смущает, что там -1036280892 вместо tc
vla-get-TrueColor тоже выдает число такого же порядка
А вычисление дает 2643842
Чего-то я, видимо, еще не понимаю.

skkkk · 26.05.2015, 12:16

RGB_color в OLE_color как это сделать?
Оно?
А также функция rgb->ole-samocad от mmax здесь.

mkung · 26.05.2015, 13:34

Цитата:

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

RGB_color в OLE_color как это сделать?
Оно?
А также функция rgb->ole-samocad от mmax здесь.

Спасибо.
Эти функции дают результат отличающийся от функции kpblc, совпадают с тем, что я вычисляю на калькуляторе по правилу, но...
Беру в свой пример значение из примера Полещука:

Код:

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

 (vla-put-EntityColor vla_color -1036280892)
(vla-put-TrueColor vla_layer vla_color)

Слою назначается цвет 55,155,196. Вычисляю:

Код:

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

 (RGB->OLE-SAMOCAD 55 155 196)

Результат: 12884791
Если подставляю это значение, то ; ошибка: Ошибка Automation. Отсутствует описание.
То есть эти функции вычисляют явно не то значение, которое ждет vla-put-EntityColor
Как получить то, что нужно функции vla-put-EntityColor?

Ubivec81 · 02.06.2015, 10:41

Здравствуйте!
Под рабочие цели написал такой вот код с разбивкой полилинии по пикетажу и подписями этого пикетажа.
Возникает проблема что на пустом чертеже все работает хорошо а при запуске на чертеже с масштабными планами текст не становится перпендикулярно линии разбивки, а идет с одним углом поворота.
Если у кого нибудь есть какие мысли подскажи что делаю не так. Заранее спасибо!!!

Код:

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

 (defun c:piketag_500 (/ piket pk_kl schet ugl tchk2 txtslyle ves cvet styl tchk)
  	(defun *error*(msg);Функция проверки на ошибки 
    		(princ msg) ; Отменено пользователем
    		(if c (setvar "OSMODE" c))
	  	(if txtslyle(setvar "textstyle" txtslyle))
	  	(if ves (setvar "CELWEIGHT" ves))
                (if cvet (setvar "CECOLOR" cvet))
	 	(if styl (setvar "clayer" styl))
  	);Конец *error*
  	(command "_.undo" "_begin")
  	(setq txtslyle (getvar "textstyle"))
  	(command "_-style" "1111111" "simplex8.shx" 1.25 0.7 10 "" "" "" )
  	(Setq c (getvar "osmode"));Сохранение значения привязок
  	(setq ves (getvar "CELWEIGHT"))
  	(setq cvet (getvar "CECOLOR"))
  	(setq styl (getvar "clayer"))
	(setvar "CELWEIGHT" 25)
  	(setvar "CECOLOR" "послою")
  	(command "_.-layer" "_make" "пикетаж_пути" "_color" "18" "" "_L" "continuous" "" "")
  	(setvar "osmode" 0)

  
  	(if (tblsearch "block" "razmetka");блок есть?
	  	(command "_measure" pause "б" "razmetka" "Д" "50"); да есть размечаем линию
	  	(progn (command "_line" '(0 0) '(0 2) ""); нет блока! рисуем линию
		  	(command "_-block" "razmetka" '(0 1) "_l" "");создаем блок
		  	(command "_measure" pause "Б" "razmetka" "Д" "50" ); размечаем путь
		 );end PROGN
	 ); end IF
  	
  	(INITGET 4)
  	(setq PK (getint "\n С КАКОГО ПИКЕТА НУМЕРОВАТЬ? <ПК 0>: "))
  	(IF ( = PK nil)
	  	(setq PK 0)
	 )
  	(command "_zoom" "_all")
	(setq piket (ssget "_P"));список точек после разбивки
  	(setq pk_kl (sslength piket)); количество точек в пикетном списке
  	(setq schet 0);счетчик
  	(while (< schet pk_kl)
	  	(setq tchk (cdr(assoc 10 (entget(ssname piket schet)))))
	  	(setq ugl(atof(angtos(cdr(assoc 50(entget(ssname(ssget tchk)0))))0 5)));получение угла поворота каждого блока
	  	(cond((and(>= ugl 90) (<= ugl 180)) (setq tchk2 (polar tchk (+ 180 ugl) 1 ))(setq ugl(+(atof(angtos(cdr(assoc 50(entget(ssname(ssget tchk)0))))0 5))180)));вычисление 
		     ((and(> ugl 180) (<= ugl 270)) (setq tchk2 (polar tchk (+ 180 ugl)  1 ))(setq ugl(+(atof(angtos(cdr(assoc 50(entget(ssname(ssget tchk)0))))0 5))180)));точек вставки
		     ((and(> ugl 270) (<= ugl 360)) (setq tchk2 (polar tchk  (+ 180 ugl)  1 ))(setq ugl(atof(angtos(cdr(assoc 50(entget(ssname(ssget tchk)0))))0 5))));текста и угла его
		     ((and(>= ugl 0) (< ugl 90)) (setq tchk2 (polar tchk  (+ ugl 180)  1 ))(setq ugl(atof(angtos(cdr(assoc 50(entget(ssname(ssget tchk)0))))0 5))));наклона
		  )
	  	(command "_text" tchk2 ugl (strcat "ПК " (itoa(+ 1 schet PK))) "")
	  	(redraw)
	  	(setq schet (1+ schet))
  	);end_WHILE
  	(setvar "osmode" C)
	(setvar "textstyle" txtslyle)
	(setvar "CELWEIGHT" ves)
	(setvar "CECOLOR" cvet)
	(setvar "clayer" styl)
	(command "_.undo" "_end")
);END_DEFUN

Кулик Алексей aka kpblc · 02.06.2015, 11:05

Во-первых, где файл, на котором неправильно срабатывает?
Во-вторых, не советую преобразовывать углы в градусы - они и в радианах прекрасно обрабатываются (константу pi еще не отменили)
В-третьих, попробуй пошагово пройти и посмотреть, чему у тебя равны переменные в каждый момент.
В-четвертых, командами создавать текст? Ты отважный человек...

perpetule · 02.06.2015, 11:25 **Ubivec81**

тут есть готовая ф-ция
_DRPK
http://dwg.ru/dnl/13203

Ubivec81 · 02.06.2015, 11:53

Цитата:

Сообщение от Кулик Алексей aka kpblc

Во-первых, где файл, на котором неправильно срабатывает?
Во-вторых, не советую преобразовывать углы в градусы - они и в радианах прекрасно обрабатываются (константу pi еще не отменили)
В-третьих, попробуй пошагово пройти и посмотреть, чему у тебя равны переменные в каждый момент.
В-четвертых, командами создавать текст? Ты отважный человек...

1. Файл в принципе с любым масштабником.
2. если не преобразовывать углы то как выводить текст если не командами.
3. Пошагово делал. на новом чертеже все работает отлично, а на масштабнике почему то ugl берется один и тот же.

Цитата:

Сообщение от тут есть готовая ф-ция
_DRPK
[url

http://dwg.ru/dnl/13203[/url]

Спасибо! погляжу как работает. но теперь уже хочется и для себя разобраться.

Кулик Алексей aka kpblc · 02.06.2015, 12:38

Цитата:

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

Файл в принципе с любым масштабником.

Вот ты ни фига не объяснил.

Цитата:

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

если не преобразовывать углы то как выводить текст если не командами.

Программно

Цитата:

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

Пошагово делал. на новом чертеже все работает отлично, а на масштабнике почему то ugl берется один и тот же.

Значит проверяй вычисления.

Ubivec81 · 02.06.2015, 12:44

файл положил.
А можно подсказать что читать что бы программно текст писать?
Я конечно сильно новичок, но не понимаю почему один и тот же код работает на разных чертежах по разному.

ShaggyDoc · 02.06.2015, 13:20

Цитата:

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

Здравствуйте!
Возникает проблема что на пустом чертеже все работает хорошо а при запуске на чертеже с масштабными планами текст не становится перпендикулярно линии разбивки, а идет с одним углом поворота.

Проверяй количество ответов в опциях команды _TEXT с учетом того, назначил ли постоянную высоту при создания стиля.

Ubivec81 · 04.06.2015, 06:52

Цитата:

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

Проверяй количество ответов в опциях команды _TEXT с учетом того, назначил ли постоянную высоту при создания стиля.

Стиль я создаю еще в начале с указанием высоты текста. Быть может и правда проблема во вставке текста командным путем! Подскажите хоть куда глядеть что бы можно было текст вставлять программно.
Не могу я понять почему в одно файле все хорошо а в другом все не так как хочется)))

ShaggyDoc · 04.06.2015, 08:38

Цитата:

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

Стиль я создаю еще в начале с указанием высоты текста. Быть может и правда проблема во вставке текста командным путем! Подскажите хоть куда глядеть что бы можно было текст вставлять программно.
Не могу я понять почему в одно файле все хорошо а в другом все не так как хочется)))

Стиль вообще не надо создавать в конкретной программе. Это очень плохая мысль. Стиль, если уж необходим какой-то "специальный" надо создавать один раз где-то в автозагрузке. Устанавливать его только тогда, когда требуется.

А "не так, как хочется" - потому, что допускается "ChildErrorNumer2" - неправильное использование команды. Если уж зачем-то создавать текст именно командным методом, надо это также вынести в отдельную функцию. Например так :

Код:

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

 (defun ru-text-draw (txt pnt height rotation justification)

  ;; пишет текст txt от точки pnt высотой height угол rotation выравнивание justification
  ;; независимо от текущей установки высоты
  ;; даже если она фиксированная
;|
Пример вызова:
(while (setq pt (ru-get-point-or-exit "Начало текста" nil)) (ru-text-draw "Проба" pt (ru-normal-text-height) 0 "R"))
|;
  (ru-var-clear-osnap)
  ;; Вариант с командой
   (if (= (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))) 	 0.0       )
;;;       ;; нулевая высота текста
       (if justification
 	(vl-cmdf "_.TEXT" "_J" justification pnt height rotation txt)
 	(vl-cmdf "_.TEXT" pnt height rotation txt)
       ) ;_ end of if
       ;; фиксированнная высота
       (if justification
 	(vl-cmdf "_.TEXT" "_J" justification pnt rotation txt)
 	(vl-cmdf "_.TEXT" pnt rotation txt)
       ) ;_ end of if
   ) ;_ end of if
  (ru-lw-set-for-ent (entlast) (ru-lw-calc-for-text height))
  (ru-var-restore-osnap)
)

.
Обратите внимание на разное количество аргументов и порядок их следования для команды TEXT. Но надежней всего писать текст объектным методом, также сделав специальную функцию. Например так:

Код:

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

 (defun ru-text-add (txt pnt height rotation justification / obj)
;;; ВНИМАНИЕ! для выравнивания A или F передается не точка текста, а список из двух точек!!
  ;|

  (if (null justification)
    (setq justification acalignmentleft)
  ) ;_ end of if
  (ru-error-catch
    (function
      (lambda ()
        (setq
          obj
           (vla-addtext
             (ru-obj-active-space)
             txt
             (if
               (or (= justification acalignmentaligned)
                   (= justification acalignmentfit)
               ) ;_ end of or
                (vlax-3d-point (car pnt))
                (vlax-3d-point pnt)
             ) ;_ end of if
             height
           ) ;_ end of vla-AddText
        ) ;_ end of setq
        (ru-lw-set-for-obj obj (ru-lw-calc-for-text height))
        (cond
          ((= justification acalignmentleft)
           (vla-put-rotation obj rotation)
          )
          ((or (= justification acalignmentaligned)
               (= justification acalignmentfit)
           ) ;_ end of or
           (vla-put-alignment obj justification)
           (vla-put-textalignmentpoint
             obj
             (vlax-3d-point (cadr pnt))
           ) ;_ end of vla-put-textalignmentpoint
          )
          (t
           (vla-put-alignment obj justification)
           (vla-put-textalignmentpoint obj (vlax-3d-point pnt))
           (vla-put-rotation obj rotation)
          )
        ) ;_ end of cond
        (vla-update obj)
        obj
      ) ;_ end of lambda
    ) ;_ end of cond
    (function (lambda (x) (princ (strcat "\nОШИБКА RU-TEXT-ADD: " x)) nil))
  ) ;_ end of ru-error-catch
) ;_ end of defun

alex8888 · 08.06.2015, 08:50

Я себе вот такую функцию написал, тоже текст программно вставляет.

Ее можно использовать и без параметров - вот так: (at_text nil), тогда она будет запросит точку вставки и сам текст, а остальные параметры подставит по умолчанию. В моем случае слой "Scrift", высота 30, угол поворота 0°, выравнивание по центру.

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

Код:

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

 
;|****************************************************************************
*            Модуль вставки текста                                           *
*   Пример вызова:                                                           *
*         (at_text (list ptm "сам текст" "schrift" 30 ugol 4))               *
*                 где ptm - точка вставки текста, обязательный параметр      *
*                     "сам текст" - текст сообщения, обязательный параметр   *
*                     "schrift" - слой для текста,  nil = "schrift"          *
*                     30 - высота текста, nil = 30                           *
*                     ugol - угол поворота текста в градусах, nil = 0        *
*                     4  - выравнивание, nil = acAlignmentMiddle             *
*      Составлен 20.07.2010  Автор: АТ                                       *
*      Изменения    20.09.2010-23.09.2010 ,09.11.2010                        *
******************************************************************************|;
(defun at_text (text_list	/		insert_point
		insert_text	text_layer	text_hoehe
		text_winkel	text_alignment	text_obj
	       )
;-------------------- Загрузка расширений -----------------------------------
  (vl-load-com)
  (begin_activex)

;-------------------- Разбор входящего списка -------------------------------
  (mapcar 'set '(insert_point insert_text text_layer text_hoehe text_winkel text_alignment) text_list)
;--------- Анализ входящих и получение значений по умолчанию ----------------
  (if (= insert_point nil)
    (progn
      (initget (+ 1 2 4))
      (setq  insert_point (getpoint "\nInsert Point: "))
       )					;progn
  )					;if
  (if (= insert_text nil)
    (setq insert_text
      (getstring T "\nInput Text: ")
        )					;getstring
  )					;if
(if (or (= text_layer nil)
    	(null (tblsearch "layer" text_layer))
     );or
    	(setq text_layer "schrift")
);if
  (if (= text_hoehe nil)
    (setq text_hoehe 30)
  )
  (if (= text_winkel nil)
    (setq text_winkel 0)
  )
  (if (= text_alignment nil)
    (setq text_alignment 4)
  )
  (if (= (type text_winkel) 'STR)
    (setq text_winkel (atof text_winkel))
  )					;if
  (if (= (type text_hoehe) 'STR)
    (setq text_hoehe (atof text_hoehe))
  )					;if
  (if (= (type insert_point) 'LIST)
    (setq insert_point (vlax-3d-point insert_point))
  )					;if
;-------------------- Тело функции ---------------------------------------
  (ru-error-catch
    (function
      (lambda ()
	(setq text_winkel (degrees_to_radians text_winkel)
	      text_obj	  (vla-addtext
			    model_space
			    insert_text
			    insert_point
			    text_hoehe
			  );vla-addtext
	);setq
	(vla-put-alignment text_obj text_alignment) ;см. Выравнивание
	(if (/= text_alignment 0)(vla-put-textalignmentpoint text_obj insert_point))
	(vla-put-layer text_obj text_layer)
	(vla-put-color text_obj 256)
	(vla-put-Rotation text_obj text_winkel)
	(vla-update text_obj)
      )	;lambda
    );function
    (function
      (lambda (x)
	(princ (strcat "\nFunktion at_text ERROR: " x))
	nil
      );lambda
    );function
  );ru-error-catch
  (princ)
);defun
;----------------------- Памятка ---------------------------------------
;Выравнивание:
; 0 acAlignmentLeft 
; 1 acAlignmentCenter 
; 2 acAlignmentRight 
; 3 acAlignmentAligned 
; 4 acAlignmentMiddle 
; 5 acAlignmentFit 
; 6 acAlignmentTopLeft 
; 7 acAlignmentTopCenter 
; 8 acAlignmentTopRight 
; 9 acAlignmentMiddleLeft 
; 10 acAlignmentMiddleCenter 
; 11 acAlignmentMiddleRight 
; 12 acAlignmentBottomLeft 
; 13 acAlignmentBottomCenter 
; 14 acAlignmentBottomRight



;-----------------------------------------------------------------------------------------------------------------------
; дополнительно



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

;|****************************************************************************
*                                                                            *
*            Функция создания слоя                                           *
*                                                                            *
*   Пример вызова:                                                           *
*         at_create_layer "Имя"                                              *
*                                                                            *
*   Составлена 08.09.2010  Автор: от Reinaldo Togores <[email protected]> *
*                                                                            *
******************************************************************************
|;
(defun at_create_layer ( / laynam)	; 

    ; (setq laynam (getstring "\nНазвание слоя: "));получение имени слоя
      ; (entmake	
        ; (list
          ; '(0 . "LAYER")	;тип примитива - слой
          ; '(5 . "28") ; метка примитива
          ; '(100 . "AcDbSymbolTableRecord") ;маркер данных подкласса
          ; '(100 . "AcDbLayerTableRecord")	;маркер данных подкласса
          ; (cons 2 laynam) ;наименование слоя
          ; '(70 . 64); режим ?
          ; '(62 . 7) ;цвет слоя
          ; '(6 . "CONTINUOUS") ;тип линий слоя
      ; )
    ; )

;layer "schrift"
	(entmake	
        (list
           '(0 . "LAYER")	;тип примитива - слой
           '(5 . "28") ; метка примитива
           '(100 . "AcDbSymbolTableRecord") ;маркер данных подкласса
           '(100 . "AcDbLayerTableRecord")	;маркер данных подкласса
           '(2 . "schrift") ;наименование слоя
           '(70 . 64); режим ?
           '(62 . 4) ;цвет слоя
           '(6 . "CONTINUOUS") ;тип линий слоя
		)
	)	

;layer "TEXT"
	(entmake	
        (list
           '(0 . "LAYER")	;тип примитива - слой
           '(5 . "28") ; метка примитива
           '(100 . "AcDbSymbolTableRecord") ;маркер данных подкласса
           '(100 . "AcDbLayerTableRecord")	;маркер данных подкласса
           '(2 . "TEXT") ;наименование слоя
           '(70 . 64); режим ?
           '(62 . 2) ;цвет слоя
           '(6 . "CONTINUOUS") ;тип линий слоя
		)
	)	
)

)

Vladimir_Sergeevich · 10.06.2015, 09:28

Господа товарищи, заболел новой идеей! Суть такова: на плане сгенерировнным робуром надо:
1) Найти группы объектов (это я сделал в первом приближении)
2) Преобразовать эти группы в анонимные аннотативные блоки.
Насколько это реализуемо и в какую сторону рыть?
Для наглядности прикладываю пример рисунка: прямоугольниками обведены те самые группы объектов, которые надо преобразовывать (элементы кривых в плане) собственно их рисовал программно по ним же и идет выбор "_WP"
P.S. Аннотативность нужна до зарезу, с анонимностью спорно, но желательно, ибо осей может быть много и каждый должен быть индивидуальным.

T.Bagdat · 23.06.2015, 20:38

Извиняюсь за дилетантщину, но надеюсь, тут все к этому привыкли, поэтому всё же осмелюсь спросить.

В лиспе небезызвестной pltools, в команде MPL есть такие строки:

Код:

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

	  (setq	dL
		 (if
		   (setq dL (getint "\nКоличество опорных точек <100>: "))
		    dL
		    100
		 )
	  )

И каждый раз при вызове, команда, запрашивая число опорных точек, по умолчанию предлагает 100.

А вот родная автокадовская команда OFFSET при новом вызове помнит, какое расстояние вводили в прошлый раз, и при очередном запуске предлагает значение, которое весит в памяти.

Можно ли это в лиспе реализовать, и если можно то как? Вот объявил я глобальную переменную, ну скажем velichina. Задал её при первом вызове команды, и хочу, чтобы при новом вызове предлагалось текущее значение. Если пишу "\nКоличество опорных точек <velichina>: ", то он так же и выдаёт <velichina>. Пишу с восклицательным знаком, и выдаёт с восклицательным. Как заставить выводить значение переменной, а не её имя?

kakt00z · 23.06.2015, 20:44

(setq dL
(if
(setq dL (getint (strcat "\nКоличество опорных точек <" (itoa dL) ">: ")))
dL
100
)
)

T.Bagdat · 24.06.2015, 08:32

kakt00z, большое спасибо за подсказку.
Данный код имеет огрех. Если значение переменной уже отличается от 100, и составляет, к примеру 50, то запрос будет выглядеть так:

Количество опорных точек <50.0000>:

Но при нажатии Enter, в переменную всё равно вносится значение 100
Победил следующим образом:
dL - глобальная переменная
dl1 - локальная переменная

Код:

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

	  (setq	dL1 dl)
	  (setq	dL
		 (if
		   (setq dL (getreal (strcat "\nКоличество опорных точек <" (rtos dL) ">: ")))
		    dL
		    dL1
		 )
	  )
	  (setq	dL1 dL)

Кулик Алексей aka kpblc · 24.06.2015, 09:10

А если примерно так:

Код:

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

 (setq dl (cond
           ((getreal (strcat "\nКоличество опорных точек <"
                             (rtos (cond
                                     (dl)
                                     (t 100.)
                                     ) ;_ end of cond
                                   2
                                   2
                                   ) ;_ end of rtos
                             "> : "
                             ) ;_ end of strcat
                     ) ;_ end of getreal
            )
           (dl)
           (t 100.)
           ) ;_ end of cond
      ) ;_ end of setq

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
LISP. Вставка в таблицу поля, соотвествующего площади примитива	Profan	Готовые программы	272	06.06.2021 23:12
Сейсмозащита и сейсмоизоляция существующих, построенных зд.	IANationalInformAgentstvo	Прочее. Архитектура и строительство	216	20.01.2015 16:51
Мониторы LCD CRT		Разное	94	17.06.2008 10:51
ЮМОР 2006 =)	Perezz!!	Разное	1122	04.01.2007 00:46

20.07.2008, 20:12
Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу) Red Nova ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ. Торонто Регистрация: 23.10.2007 Сообщений: 1,980 Со школы не ладится у меня с программированием. Все предметы щелкал, а на экзамене по информатике (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 _____________________________________________________________________________________________________________ Прошло много лет и топик теперь представляет из себя площадку для обучения азов программирования для многих начинающих. Так что начинающие лиспогрызы приветствуются . __________________ Блог Последний раз редактировалось Red Nova, 12.07.2017 в 05:43.
Просмотров: 1972961