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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)

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

Ответ
Поиск в этой теме
Непрочитано 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.
Просмотров: 1965720
 
Непрочитано 25.06.2018, 21:39
#3601
gnuvse


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


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Ну или образец файла в студию
test1.dwg
gnuvse вне форума  
 
Непрочитано 25.06.2018, 21:41
#3602
Кулик Алексей aka kpblc
Moderator

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


У меня нет доступа на яндекс.диск

Вот интересно, а кто мешает файл напрямую в пост приложить?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 26.06.2018, 10:41
#3603
gnuvse


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


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

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

test.dwg
gnuvse вне форума  
 
Непрочитано 26.06.2018, 10:52
#3604
Maksim7enov


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


Здравствуйте! Написал маленькую программу с диалоговым окном DCL, для построения продольных профилей, все вроде работает. Так как только учусь не могли бы Вы проверить код на грамотность и подсказать какие места кода можно заменить, чтобы он стал более устойчив в работе. Так же не могу понять как можно объединить все в один файл Lsp, и стоит ли это делать?
Код Lisp
Код:
[Выделить все]
;|
***************************************************************************************************
*
*			Для простроения продольного профиля
*
***************************************************************************************************
* Программа с диалоговым окном для простроения продольного профиля инженерных сетей, работает в паре
*	с блоком профиль, или боковиком по форме 2. Строит участки трубопроводов по заданному уклону
*	и длине. Программа задает в диалоговом окне 3 вопроса.
***************************************************************************************************
* Глобальные переменные (для запонинания предыдущих вычислений):
* - gl_mark_z - Для начальной отметки земли
* - gl_mark_l - Для отметки лотка трубопровода
* - gl_slope - Для назначения уклона трубопровода
* - gl_length_1 - Для указания расстояния между участками
* - gl_diam_1 - Для указания диаметра трубопровода
* - vopros_1 - Вопрос 1. Указываь ли на профиле трубопровод с учетом диаметра?
* - vopros_2 - Вопрос 2. Указываь ли на профиле уклон трубопроводов?
* - vopros_3 - Вопрос 3. Указываь ли на профиле длину участка?
***************************************************************************************************
* Локальные переменные: 
* - pt1 - Точка отчета для построения
* - pt2 - Вспомогательная точка
* - rs_otm_1 - расчет отметки после уклона
* - text_1 - отметка после уклона
* - inpoi_text_1 - точка вставки text_1 для выравнивания (вспомогательная)
* - rasst_2 - Вспомогательная для длины
***************************************************************************************************
|;

(defun c:7en-profil (/ vopros_1 vopros_2 vopros_3)
(vl-load-com)
 (defun 7en_param_dc ()
  (setq gl_mark_z   (atof (get_tile "dc_otm1"))
        gl_mark_l   (atof (get_tile "dc_otm2"))
        gl_slope    (atof (get_tile "dc_uclon"))
        gl_length_1 (atof (get_tile "dc_rasst1"))
        gl_diam_1   (atof (get_tile "dc_diam_1"))
        vopros_1    (get_tile "dc_diam")
        vopros_2    (get_tile "dc_uclon_1")
        vopros_3    (get_tile "dc_dlina")
        ) ;_ end of_setq
  ) ;_ end of_defun
 (defun profil_rs (gl_mark_z gl_mark_l gl_slope gl_length_1 vopros_1 gl_diam_1 vopros_2 vopros_3 / old_value pt1 pt2 text_1 inpoi_text_1 rs_otm_1 step rasst_2)
                    ;---------------------------------------------------------------------;
  (vl-load-com)
  (setq acad_aplication (vlax-get-acad-object))
  (setq active_document (vla-get-activedocument acad_aplication))
  (setq model_space (vla-get-modelspace active_document)) ;------------------------------------;
  (setq old_value (getvar 'osmode))
  (setvar 'osmode 32)
  (setvar "CMDECHO" 0)
  (setq old_text (getvar "textstyle"))
  (if (not (tblobjname "style" "_GOST"))
   (vl-cmdf "_.style" "_GOST" "isocpeur" "0" "1" "0" "_n" "")
   ) ;_ end of_if
  (setvar "textstyle" "_GOST")
  (if (< 0 gl_length_1)
   (progn (setq pt1      (getpoint "\nУкажите начальную точку :")
                pt2      (polar pt1 0 gl_length_1)
                rs_otm_1 (- gl_mark_l (* gl_length_1 gl_slope))
                ) ;_ end of_setq
          (vla-put-lineweight
           (vla-addline
            model_space
            (vlax-3d-point (polar pt1 (/ pi 2) ((lambda (x) (* (/ (- x gl_mark_z) 2) 10)) gl_mark_l)))
            (vlax-3d-point (polar pt2 (/ pi 2) ((lambda (x) (* (/ (- x gl_mark_z) 2) 10)) rs_otm_1))) ;_ end of_vlax-3d-point
            ) ;_ end of_Vla-addLine
           15
           ) ;_ end of_vla-put-Lineweight
          (setq text_1 (vla-addtext
                        model_space
                        (vl-princ-to-string (rtos rs_otm_1 2 2))
                        (vlax-3d-point (polar pt2 (/ pi 2) -3.75))
                        1.25
                        ) ;_ end of_vla-addtext
                ) ;_ end of_setq
          (vla-put-rotation text_1 1.5708)
          (setq inpoi_text_1 (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint text_1))))
          (vla-put-lineweight text_1 15)
          (vla-put-insertionpoint
           text_1
           (vlax-safearray-fill
            (vlax-make-safearray
             vlax-vbdouble
             (cons 0 (1- (length (mapcar '- inpoi_text_1 (list 0.5 1.6875 0)))))
             ) ;_ end of_vlax-Make-SafeArray
            (mapcar '- inpoi_text_1 (list 0.5 1.6875 0))
            ) ;_ end of_vlax-SafeArray-Fill
           ) ;_ end of_vla-Put-InsertionPoint
          ) ;_ end of_progn
   (progn (setq pt1      (getpoint "\nУкажите начальную точку :")
                pt2      (polar pt1 0 gl_length_1)
                rs_otm_1 (+ gl_mark_l (* gl_length_1 gl_slope))
                ) ;_ end of_setq
          (vla-put-lineweight
           (vla-addline
            model_space
            (vlax-3d-point (polar pt1 (/ pi 2) ((lambda (x) (* (/ (- x gl_mark_z) 2) 10)) gl_mark_l)))
            (vlax-3d-point (polar pt2 (/ pi 2) ((lambda (x) (* (/ (- x gl_mark_z) 2) 10)) rs_otm_1))) ;_ end of_vlax-3d-point
            ) ;_ end of_vla-addline
           15
           ) ;_ end of_vla-put-Lineweight
          (setq text_1 (vla-addtext
                        model_space
                        (vl-princ-to-string (rtos rs_otm_1 2 2))
                        (vlax-3d-point (polar pt2 (/ pi 2) -3.75))
                        1.25
                        ) ;_ end of_vla-addtext
                ) ;_ end of_setq
          (vla-put-rotation text_1 1.5708)
          (vla-put-lineweight text_1 15)
          (setq inpoi_text_1 (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint text_1))))
          (vla-put-insertionpoint
           text_1
           (vlax-safearray-fill
            (vlax-make-safearray
             vlax-vbdouble
             (cons 0 (1- (length (mapcar '- inpoi_text_1 (list 0.5 1.6875 0)))))
             ) ;_ end of_vlax-Make-SafeArray
            (mapcar '- inpoi_text_1 (list 0.5 1.6875 0))
            ) ;_ end of_vlax-SafeArray-Fill
           ) ;_ end of_vla-Put-InsertionPoint
          ) ;_ end of_progn
   ) ;_ end of_if
                    ;-----------------------построение трубы с учетом диаметра;
  (if (= vopros_1 "1")
   (progn
    (vla-put-lineweight
     (vla-addline
      model_space
      (vlax-3d-point
       (polar pt1 (/ pi 2) ((lambda (x) (* (/ (- x gl_mark_z) 2) 10)) (+ gl_mark_l (/ gl_diam_1 1000))))
       ) ;_ end of_vlax-3d-point
      (vlax-3d-point
       (polar pt2 (/ pi 2) ((lambda (x) (* (/ (- x gl_mark_z) 2) 10)) (+ rs_otm_1 (/ gl_diam_1 1000))))
       ) ;_ end of_vlax-3d-point
      ) ;_ end of_vla-addline
     15
     ) ;_ end of_vla-addline
    ) ;_ end of_progn
   ) ;_ end of_if
                    ;----------------------нанесение улона на профиль-------------------------------------
  (if (= vopros_2 "1")
   (progn (vla-put-lineweight
           (vla-addline
            model_space
            (vlax-3d-point (polar pt1 (/ pi 2) -35))
            (vlax-3d-point (polar pt2 (/ pi 2) -40))
            ) ;_ end of_vla-addline
           15
           ) ;_ end of_vla-put-Lineweight
 ;_ end of_vla-addline
          (vla-put-lineweight
           (vla-addtext
            model_space
            (vl-princ-to-string (rtos (abs gl_length_1) 2 2))
            (vlax-3d-point (mapcar '+ pt1 (list (- (* gl_length_1 0.25) 1.6875) -38.75)))
            1.25
            ) ;_ end of_vla-addtext
           15
           ) ;_ end of_vla-addtext
          (vla-put-lineweight
           (vla-addtext
            model_space
            (vl-princ-to-string (rtos gl_slope 2 4))
            (vlax-3d-point (mapcar '- pt2 (list (+ (* gl_length_1 0.25) 1.5) 37.5)))
            1.25
            ) ;_ end of_vla-addtext
           15
           ) ;_ end of_vla-addtext
          ) ;_ end of  progn
   ) ;_ end of_if
                    ;----------------------нанесение длины на профиль-------------------------------------
  (if (= vopros_3 "1")
   (vla-put-lineweight
    (vla-addtext
     model_space
     (vl-princ-to-string (rtos (abs gl_length_1) 2 2))
     (vlax-3d-point (mapcar '+ pt1 (list (- (/ gl_length_1 2) 1.6875) -43.125)))
     1.25
     ) ;_ end of_vla-addtext
    15
    ) ;_ end of_vla-addtext
   ) ;_ end of  if
  (setvar 'osmode old_value)
  (setvar 'textstyle old_text)
  ) ;_ end of_defun
                    ;---------------Диалоговое окно------------------------;
 (setq dcl_id (load_dialog "C:\\Работаем\\AutoCAD\\ЛИСП\\Dialog_Profil.DCL")) ;Изменить на путь в своей папке
 (setq step 2)
 (if (null rasst_2)
  (setq rasst_2 (vl-princ-to-string gl_length_1))
  ) ;_ end of  if
 (while (>= step 2)
  (if (null (new_dialog "ProfiL" dcl_id))
   (exit)
   ) ;_ end of_if
  (set_tile "dc_otm1" (vl-princ-to-string gl_mark_z))
  (set_tile "dc_otm2" (vl-princ-to-string gl_mark_l))
  (set_tile "dc_uclon" (vl-princ-to-string gl_slope))
  (set_tile "dc_rasst1" (vl-princ-to-string rasst_2))
  (set_tile "dc_rasst1" (vl-princ-to-string rasst_2))


  (action_tile "accept" "(7en_param_dc) (done_dialog 1)") ;Если нажата кнопка "аccept"
  (setq step (start_dialog))
  (cond ((= step 3)
         (setq rasst_2 (vla-get-textstring (vlax-ename->vla-object (car (entsel "\nВыберите длину трубопровода :")))))
         )
        ((= step 1)
         (profil_rs gl_mark_z gl_mark_l gl_slope gl_length_1 vopros_1 gl_diam_1 vopros_2 vopros_3)
         )
        ) ;_ end of  cond
 ;_ end of  while
  ) ;_ end of  while
 (unload_dialog dcl_id) ;выгрузить Диалоговое окно
 ) ;_ end of_DEFUN
Код DCL
Код:
[Выделить все]
ProfiL: dialog {label = "Построение продольного профиля"; // начало диалога

    : text {label = "Введите данные для построения";
    key = "dc_text_1";}  // текстовые
    
: boxed_column {
        : edit_box {label = "Введите отметку уровня земли м.";
    key = "dc_otm1"; edit_width=8; value = "32";}      // редактируемые
    
    : edit_box {label = "Введите начальную отметку лотка м.";
    key = "dc_otm2"; edit_width=8; value = "34.78";}      // редактируемые
    
    : edit_box {label = "Укажите уклон трубопровода ";
    key = "dc_uclon"; edit_width=8; value = "0.02";}   // редактируемые

    :column {
    : edit_box {label = "Укажите длину участка трубопровда:";
    key = "dc_rasst1"; edit_width=8; value = "10.15";}    // редактируемые
  
    :button {label="Указать <";key="mousep";height=0; fixed_width=true;
action="(done_dialog 3)";}
    }
     : edit_box {label = "Укажите диаметр трубопровода:";
    key = "dc_diam_1"; edit_width=8; value = "300";}     // редактируемые
    
    : spacer{height=1;}   // вставка пустой строки
    }

: text {label = "Дополнение";
key = "dc_text_2";}  // текстовые

: boxed_column {
: toggle {label = "Нанести на профиль трубу с диаметром ?"; 
key = "dc_diam"; value = "1"; }

: toggle {label = "Указать на профиле уклон ?"; 
key = "dc_uclon_1"; value = "1"; }

: toggle {label = "Указать на профиле длину участка ?"; 
key = "dc_dlina"; value = "1"; }
}

    : text {label = "*Примечание: при указании длины участка со знаком ";
    key = "dc_text_3";}  // текстовые
        : text {label = "<-> уклон в левую сторону";
    key = "dc_text_4";}  // текстовые
    
    ok_cancel;   // добавление кнопок ОК и Отмена
}  // окончание диалога
Maksim7enov вне форума  
 
Непрочитано 26.06.2018, 10:54
#3605
Кулик Алексей aka kpblc
Moderator

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


Maksim7enov, http://autolisp.ru/2015/02/05/dcl-develop/ не поможет?

----- добавлено через ~2 мин. -----
gnuvse, у тебя там нет текстов. Есть мультивыноска - но это отдельная песня.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 26.06.2018, 11:02
#3606
Maksim7enov


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


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Maksim7enov, http://autolisp.ru/2015/02/05/dcl-develop/ не поможет?
Пробовал, но не получается у меня) Сегодня и завтра еще раз попробую!
Также пробовал воспользоваться программой которая сама делает из файла DCL лисп, но опять же не получается. Я до выходных опять попробую и результаты выложу, чтобы можно было определить где ошибка.
Maksim7enov вне форума  
 
Непрочитано 26.06.2018, 13:23
#3607
gnuvse


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


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
gnuvse, у тебя там нет текстов. Есть мультивыноска - но это отдельная песня.
Я выше писал, что и с TEXT и MTEXT тоже самое - возвращает nil
gnuvse вне форума  
 
Непрочитано 26.06.2018, 15:31
1 | #3608
Кулик Алексей aka kpblc
Moderator

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


А так? Тупо и топорно, но у меня работало корректно. Тексты меняют выравнивание и остаются на местах.
Код:
[Выделить все]
 (vl-load-com)
(defun test2 (/ ent a minps maxps minp maxp)
  (if (and (= (type
                (setq ent (vl-catch-all-apply
                            (function (lambda () (vlax-ename->vla-object (ssname (ssget "_+.:S:E:L" '((0 . "TEXT"))) 0))))
                            ) ;_ end of VL-CATCH-ALL-APPLY
                      ) ;_ end of setq
                ) ;_ end of type
              'vla-object
              ) ;_ end of =
           (member (setq a (vla-get-alignment ent))
                   (list acalignmentleft acalignmentright acalignmenttopleft acalignmenttopright acalignmentmiddleleft acalignmentmiddleright acalignmentbottomleft acalignmentbottomright) 
                   ) ;_ end of member
           ) ;_ end of and
    (progn (vla-getboundingbox ent 'minps 'maxps)
           (vla-put-alignment ent
                              (cond ((= a acalignmentleft) acalignmentright)
                                    ((= a acalignmentright) acalignmentleft)
                                    ((= a acalignmenttopleft) acalignmenttopright)
                                    ((= a acalignmenttopright) acalignmenttopleft)
                                    ((= a acalignmentmiddleleft) acalignmentmiddleright)
                                    ((= a acalignmentmiddleright) acalignmentmiddleleft)
                                    ((= a acalignmentbottomleft) acalignmentbottomright)
                                    ((= a acalignmentbottomright) acalignmentbottomleft)
                                    ) ;_ end of cond
                              ) ;_ end of vla-put-Alignment
           (vla-update ent)
           (vla-getboundingbox ent 'minp 'maxp)
           (vla-move ent
                     (vlax-3d-point (vlax-safearray->list minp))
                     (vlax-3d-point (vlax-safearray->list minps))
                     ) ;_ end of vla-move
           ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 27.06.2018, 08:49
#3609
gnuvse


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


Спасибо, сегодня потестирую.


Подскажите, как можно перебирать элементы строки в цикле?
И верен ли этот метод для списков?
gnuvse вне форума  
 
Непрочитано 27.06.2018, 08:50
#3610
Кулик Алексей aka kpblc
Moderator

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


Лучше не тестировать, а разбирать код и находить проблемные места
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 27.06.2018, 10:17
#3611
gnuvse


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


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Лучше не тестировать, а разбирать код и находить проблемные места
Проблемные места пока рано разбирать.
А как работает разбираю конечно.



Как можно строку преобразовать в список?

Последний раз редактировалось gnuvse, 27.06.2018 в 17:45.
gnuvse вне форума  
 
Непрочитано 28.06.2018, 10:55
#3612
Maksim7enov


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


Цитата:
Сообщение от Maksim7enov Посмотреть сообщение
Сегодня и завтра еще раз попробую!
Все скомпилировал в Vlx.


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
http://autolisp.ru/2015/02/05/dcl-develop/ не поможет?
Слабоват я еще для такого, сложно понять как свое туда запихнуть.

Пытался сделать по этому примеру http://autolisp.ru/2010/03/15/dcl-dialogs-create/ но видимо рано мне еще лезть в такие вещи)
В выходные времени будет больше, попытаюсь еще.
Maksim7enov вне форума  
 
Непрочитано 28.06.2018, 11:32
#3613
Кулик Алексей aka kpblc
Moderator

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


Да тут все просто - внутрь основной функции lsp засовываешь кусок, который в %temp% создает временный dcl-файл. А потом уже обычными методами вызываешь dcl-окно и обрабатываешь его.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 28.06.2018, 12:30
#3614
Maksim7enov


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


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Да тут все просто
Сделал. Пришлось везде в диалоге ставить "\".
Стал выдавать ошибку "Не удается открыть файл C:\TEMP\dld.dcl -- error 0"
Код после изменения прикладываю
Код:
[Выделить все]
(defun c:7en_profil (/ vopros_1 vopros_2 vopros_3)
(vl-load-com)
  
 (defun 7en_param_dc ()
  (setq gl_mark_z   (atof (get_tile "dc_otm1"))
        gl_mark_l   (atof (get_tile "dc_otm2"))
        gl_slope    (atof (get_tile "dc_uclon"))
        gl_length_1 (atof (get_tile "dc_rasst1"))
        gl_diam_1   (atof (get_tile "dc_diam_1"))
        vopros_1    (get_tile "dc_diam")
        vopros_2    (get_tile "dc_uclon_1")
        vopros_3    (get_tile "dc_dlina")
        ) ;_ end of_setq
  ) ;_ end of_defun
 (defun profil_rs (gl_mark_z gl_mark_l gl_slope gl_length_1 vopros_1 gl_diam_1 vopros_2 vopros_3 / old_value pt1 pt2 text_1 inpoi_text_1 rs_otm_1 step rasst_2)
                    ;---------------------------------------------------------------------;
  (vl-load-com)
  (setq acad_aplication (vlax-get-acad-object))
  (setq active_document (vla-get-activedocument acad_aplication))
  (setq model_space (vla-get-modelspace active_document)) ;------------------------------------;
  (setq old_value (getvar 'osmode))
  (setvar 'osmode 32)
  (setvar "CMDECHO" 0)
  (setq old_text (getvar "textstyle"))
  (if (not (tblobjname "style" "_GOST"))
   (vl-cmdf "_.style" "_GOST" "isocpeur" "0" "1" "0" "_n" "")
   ) ;_ end of_if
  (setvar "textstyle" "_GOST")
  (if (< 0 gl_length_1)
   (progn (setq pt1      (getpoint "\nУкажите начальную точку :")
                pt2      (polar pt1 0 gl_length_1)
                rs_otm_1 (- gl_mark_l (* gl_length_1 gl_slope))
                ) ;_ end of_setq
          (vla-put-lineweight
           (vla-addline
            model_space
            (vlax-3d-point (polar pt1 (/ pi 2) ((lambda (x) (* (/ (- x gl_mark_z) 2) 10)) gl_mark_l)))
            (vlax-3d-point (polar pt2 (/ pi 2) ((lambda (x) (* (/ (- x gl_mark_z) 2) 10)) rs_otm_1))) ;_ end of_vlax-3d-point
            ) ;_ end of_Vla-addLine
           15
           ) ;_ end of_vla-put-Lineweight
          (setq text_1 (vla-addtext
                        model_space
                        (vl-princ-to-string (rtos rs_otm_1 2 2))
                        (vlax-3d-point (polar pt2 (/ pi 2) -3.75))
                        1.25
                        ) ;_ end of_vla-addtext
                ) ;_ end of_setq
          (vla-put-rotation text_1 1.5708)
          (setq inpoi_text_1 (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint text_1))))
          (vla-put-lineweight text_1 15)
          (vla-put-insertionpoint
           text_1
           (vlax-safearray-fill
            (vlax-make-safearray
             vlax-vbdouble
             (cons 0 (1- (length (mapcar '- inpoi_text_1 (list 0.5 1.6875 0)))))
             ) ;_ end of_vlax-Make-SafeArray
            (mapcar '- inpoi_text_1 (list 0.5 1.6875 0))
            ) ;_ end of_vlax-SafeArray-Fill
           ) ;_ end of_vla-Put-InsertionPoint
          ) ;_ end of_progn
   (progn (setq pt1      (getpoint "\nУкажите начальную точку :")
                pt2      (polar pt1 0 gl_length_1)
                rs_otm_1 (+ gl_mark_l (* gl_length_1 gl_slope))
                ) ;_ end of_setq
          (vla-put-lineweight
           (vla-addline
            model_space
            (vlax-3d-point (polar pt1 (/ pi 2) ((lambda (x) (* (/ (- x gl_mark_z) 2) 10)) gl_mark_l)))
            (vlax-3d-point (polar pt2 (/ pi 2) ((lambda (x) (* (/ (- x gl_mark_z) 2) 10)) rs_otm_1))) ;_ end of_vlax-3d-point
            ) ;_ end of_vla-addline
           15
           ) ;_ end of_vla-put-Lineweight
          (setq text_1 (vla-addtext
                        model_space
                        (vl-princ-to-string (rtos rs_otm_1 2 2))
                        (vlax-3d-point (polar pt2 (/ pi 2) -3.75))
                        1.25
                        ) ;_ end of_vla-addtext
                ) ;_ end of_setq
          (vla-put-rotation text_1 1.5708)
          (vla-put-lineweight text_1 15)
          (setq inpoi_text_1 (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint text_1))))
          (vla-put-insertionpoint
           text_1
           (vlax-safearray-fill
            (vlax-make-safearray
             vlax-vbdouble
             (cons 0 (1- (length (mapcar '- inpoi_text_1 (list 0.5 1.6875 0)))))
             ) ;_ end of_vlax-Make-SafeArray
            (mapcar '- inpoi_text_1 (list 0.5 1.6875 0))
            ) ;_ end of_vlax-SafeArray-Fill
           ) ;_ end of_vla-Put-InsertionPoint
          ) ;_ end of_progn
   ) ;_ end of_if
                    ;-----------------------построение трубы с учетом диаметра;
  (if (= vopros_1 "1")
   (progn
    (vla-put-lineweight
     (vla-addline
      model_space
      (vlax-3d-point
       (polar pt1 (/ pi 2) ((lambda (x) (* (/ (- x gl_mark_z) 2) 10)) (+ gl_mark_l (/ gl_diam_1 1000))))
       ) ;_ end of_vlax-3d-point
      (vlax-3d-point
       (polar pt2 (/ pi 2) ((lambda (x) (* (/ (- x gl_mark_z) 2) 10)) (+ rs_otm_1 (/ gl_diam_1 1000))))
       ) ;_ end of_vlax-3d-point
      ) ;_ end of_vla-addline
     15
     ) ;_ end of_vla-addline
    ) ;_ end of_progn
   ) ;_ end of_if
                    ;----------------------нанесение улона на профиль-------------------------------------
  (if (= vopros_2 "1")
   (progn (vla-put-lineweight
           (vla-addline
            model_space
            (vlax-3d-point (polar pt1 (/ pi 2) -35))
            (vlax-3d-point (polar pt2 (/ pi 2) -40))
            ) ;_ end of_vla-addline
           15
           ) ;_ end of_vla-put-Lineweight
 ;_ end of_vla-addline
          (vla-put-lineweight
           (vla-addtext
            model_space
            (vl-princ-to-string (rtos (abs gl_length_1) 2 2))
            (vlax-3d-point (mapcar '+ pt1 (list (- (* gl_length_1 0.25) 1.6875) -38.75)))
            1.25
            ) ;_ end of_vla-addtext
           15
           ) ;_ end of_vla-addtext
          (vla-put-lineweight
           (vla-addtext
            model_space
            (vl-princ-to-string (rtos gl_slope 2 4))
            (vlax-3d-point (mapcar '- pt2 (list (+ (* gl_length_1 0.25) 1.5) 37.5)))
            1.25
            ) ;_ end of_vla-addtext
           15
           ) ;_ end of_vla-addtext
          ) ;_ end of  progn
   ) ;_ end of_if
                    ;----------------------нанесение длины на профиль-------------------------------------
  (if (= vopros_3 "1")
   (vla-put-lineweight
    (vla-addtext
     model_space
     (vl-princ-to-string (rtos (abs gl_length_1) 2 2))
     (vlax-3d-point (mapcar '+ pt1 (list (- (/ gl_length_1 2) 1.6875) -43.125)))
     1.25
     ) ;_ end of_vla-addtext
    15
    ) ;_ end of_vla-addtext
   ) ;_ end of  if
  (setvar 'osmode old_value)
  (setvar 'textstyle old_text)
  ) ;_ end of_defun


(setq file   (strcat (vl-string-right-trim
           "\\"
           (vla-get-tempfilepath
       (vla-get-files
         (vla-get-preferences (vlax-get-acad-object))
         ) ;_ end of vla-get-files
       ) ;_ end of vla-get-tempfilepath
           ) ;_ end of vl-string-right-trim
         "\\dlg.dcl"
         ) ;_ end of strcat
      handle (open file "w")
      ) ;_ end of setq
(foreach item
        '("dlg:dialog {label = \"lispru dialog\"; // начало диалога

    : text {label = \"Введите данные для построения\";
    key = \"dc_text_1\";}  // текстовые
    
: boxed_column {
        : edit_box {label = \"Введите отметку уровня земли м.\";
    key = \"dc_otm1\"; edit_width=8; value = \"32\";}      // редактируемые
    
    : edit_box {label = \"Введите начальную отметку лотка м.\";
    key = \"dc_otm2\"; edit_width=8; value = \"34.78\";}      // редактируемые
    
    : edit_box {label = \"Укажите уклон трубопровода \";
    key = \"dc_uclon\"; edit_width=8; value = \"0.02\";}   // редактируемые

    :column {
    : edit_box {label = \"Укажите длину участка трубопровда:\";
    key = \"dc_rasst1\"; edit_width=8; value = \"10.15\";}    // редактируемые
  
    :button {label=\"Указать <\";key=\"mousep\";height=0; fixed_width=true;
action=\"(done_dialog 3)\";}
    }
     : edit_box {label = \"Укажите диаметр трубопровода:\";
    key = \"dc_diam_1\"; edit_width=8; value = \"300\";}     // редактируемые
    
    : spacer{height=1;}   // вставка пустой строки
    }

: text {label = \"Дополнение\";
key = \"dc_text_2\";}  // текстовые

: boxed_column {
: toggle {label = \"Нанести на профиль трубу с диаметром ?\"; 
key = \"dc_diam\"; value = \"1\"; }

: toggle {label = \"Указать на профиле уклон ?\"; 
key = \"dc_uclon_1\"; value = \"1\"; }

: toggle {label = \"Указать на профиле длину участка ?\"; 
key = \"dc_dlina\"; value = \"1\"; }
}

    : text {label = \"*Примечание: при указании длины участка со знаком \";
    key = \"dc_text_3\";}  // текстовые
        : text {label = \"<-> уклон в левую сторону\";
    key = \"dc_text_4\";}  // текстовые
    
    ok_cancel;   // добавление кнопок ОК и Отмена
}
")
  (write-line item handle)
  ) ;_ end of foreach
(close handle)
  
                    ;---------------Диалоговое окно------------------------;
 (setq dcl_id (load_dialog file)) ;загружаем диалоговое окно
 (setq step 2)
 (if (null rasst_2)
  (setq rasst_2 (vl-princ-to-string gl_length_1))
  ) ;_ end of  if
 (while (>= step 2)
  (if (null (new_dialog "dlg" dcl_id))
   (exit)
   ) ;_ end of_if
  (set_tile "dc_otm1" (vl-princ-to-string gl_mark_z))
  (set_tile "dc_otm2" (vl-princ-to-string gl_mark_l))
  (set_tile "dc_uclon" (vl-princ-to-string gl_slope))
  (set_tile "dc_rasst1" (vl-princ-to-string rasst_2))
  (set_tile "dc_rasst1" (vl-princ-to-string rasst_2))
  (action_tile "accept" "(7en_param_dc) (done_dialog 1)") ;Если нажата кнопка "аccept"
  (setq step (start_dialog))
  (cond ((= step 3)
         (setq rasst_2 (vla-get-textstring (vlax-ename->vla-object (car (entsel "\nВыберите длину трубопровода :")))))
         )
        ((= step 1)
         (profil_rs gl_mark_z gl_mark_l gl_slope gl_length_1 vopros_1 gl_diam_1 vopros_2 vopros_3)
         )
        ) ;_ end of  cond
 ;_ end of  while
  ) ;_ end of  while
 (unload_dialog dcl_id) ;выгрузить Диалоговое окно
 ) ;_ end of_DEFUN
Maksim7enov вне форума  
 
Непрочитано 28.06.2018, 12:37
#3615
Кулик Алексей aka kpblc
Moderator

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


После какого-то обновления на сайте почему-то стали не всегда корректно показываться "\" - пришлось править. Если еще обнаружишь ошибки - пиши прямо там, буду по мере поступления исправлять
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 29.06.2018, 17:00
#3616
gnuvse


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


Здравствуйте.

Пытаюсь написать функцию, которая должна преобразовать строку в список.

На данном этапе она не работает вообще.

При проверке участка кода начинающегося с (if (not flag-quotes) интерпретатор выдает ошибку - error: too many arguments: (IF (NOT FLAG-QUOTES) (IF ( ... ) ( ... ) ( ... )) (PROGN ( ... ) ( ... )) ... )

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


Спасибо.


Код:
[Выделить все]
 (defun substr->list	(str / s)
	(setq s (read (strcat "(" str ")")))
	s
)




(defun str->list (str/ i j l flag word symbol quotes? flag-quotes quotes-counter)
	(setq i 1)
	(setq l '())
	(setq word "")
	(setq symbol " ")

										
	(setq quotes "")
	(setq flag-quotes nil)




	(while (/= (substr str i 1) "")
		(setq symbol (substr str i 1))

		(if	(= symbol "\"")
			(progn
				(setq flag-quotes t)
				(setq quotes-counter 0)
				(setq j i)
			)
		)

		(if	(not flag-quotes)
			(if	(and (/= symbol " ") (/= symbol "(" ")"))
				(setq word (strcat word symbol))
				(progn
					(setq l (append l (substr->list word)))
					(setq word "")
				)
			)
			(progn
				(while (and (/= quotes-counter 2) (= flag-quotes t))
					(setq symbol (substr str j 1))
					(if	(/= symbol "\"")
						(progn
							(setq symbol (substr str j 1))
							(setq word (strcat word symbol))
						)
						(if	(= symbol "\"")
							(progn
								(setq quotes-counter (1+ quotes-counter))
								(setq word (strcat word symbol))
							)
						)
					)
					(setq j (1+ j))
				)
				(setq l (append l (substr->list word)))
			)
			(setq i (1+ i))
		)
	)
	(setq l (append l (substr->list word)))
	l
)
gnuvse вне форума  
 
Непрочитано 29.06.2018, 17:27
1 | #3617
Кулик Алексей aka kpblc
Moderator

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


Проверяй соответствие скобок.
ИМХО как-то немного наворочен код. У меня другой вариант, пока что нормально работает:
Код:
[Выделить все]
 (defun _kpblc-conv-string-to-list (string separator / i)
                                  ;|
*    Функция разбора строки. Возвращает список
*    Параметры вызова:
*  string    разбираемая строка
*  separator  символ, используемый в качестве разделителя частей
*    Примеры вызова:
(_kpblc-conv-string-to-list "1;2;3;4;5;6" ";")  ;-> '(1 2 3 4 5 6)
(_kpblc-conv-string-to-list "1;2" ";")          ;-> '(1 2)
(_kpblc-conv-string-to-list "1,2" ",")          ;-> '(1 2)
(_kpblc-conv-string-to-list "1.2" ".")          ;-> '(1 2)
|;
  (cond ((= string "") nil)
        ((vl-string-search separator string)
         ((lambda (/ pos res)
            (while (setq pos (vl-string-search separator string))
              (setq res    (cons (substr string 1 pos) res)
                    string (substr string (+ (strlen separator) 1 pos))
                    ) ;_ end of setq
              ) ;_ end of while
            (reverse (cons string res))
            ) ;_ end of lambda
          )
         )
        ((and (not (member separator '("`" "#" "@" "." "*" "?" "~" "[" "]" "-" ",")))
              (wcmatch (strcase string) (strcat "*" (strcase separator) "*"))
              ) ;_ end of and
         ((lambda (/ pos res _str prev)
            (setq pos  1
                  prev 1
                  _str (substr string pos)
                  ) ;_ end of setq
            (while (<= pos (1+ (- (strlen string) (strlen separator))))
              (if (wcmatch (strcase (substr string pos (strlen separator))) (strcase separator))
                (setq res    (cons (substr string 1 (1- pos)) res)
                      string (substr string (+ (strlen separator) pos))
                      pos    0
                      ) ;_ end of setq
                ) ;_ end of if
              (setq pos (1+ pos))
              ) ;_ end of while
            (if (< (strlen string) (strlen separator))
              (setq res (cons string res))
              ) ;_ end of if
            (if (or (not res) (= _str string))
              (setq res (list string))
              (reverse res)
              ) ;_ end of if
            ) ;_ end of lambda
          )
         )
        (t (list string))
        ) ;_ end of cond
  ) ;_ end of defun
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 29.06.2018, 17:28
1 | #3618
Alan

CAD
 
Регистрация: 28.08.2003
Киев
Сообщений: 1,835
<phrase 1=


Цитата:
Сообщение от gnuvse Посмотреть сообщение
При проверке участка кода начинающегося с (if (not flag-quotes) интерпретатор выдает ошибку - error: too many arguments: (IF (NOT FLAG-QUOTES) (IF ( ... ) ( ... ) ( ... )) (PROGN ( ... ) ( ... )) ... )
Вот тут всё и написано. Видны явные ошибки текста!

Первое, что нужно сделать это отформатировать текст средствами редактора. Появятся метки окончания циклов.
Второе. При отладке ставь точки останова и пошагово работай. В этой теме об этом писалось не раз.
Цитата:
Пытаюсь анализировать код, но не могу понять в чем дело.
Вот это и анализируй и понимай. Удачи!
__________________
По теории майский жук летать не может.
Но он этого не знает. И летает...
Alan вне форума  
 
Непрочитано 29.06.2018, 17:29
#3619
gnuvse


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


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Проверяй соответствие скобок.
ИМХО как-то немного наворочен код. У меня другой вариант, пока что нормально работает:
Алексей, конечно наворочен, я же нуб еще. Решаю в лоб, как могу.
А за совет и свой код спасибо, буду изучать.

----- добавлено через ~4 мин. -----
Цитата:
Сообщение от Alan Посмотреть сообщение
Первое, что нужно сделать это отформатировать текст средствами редактора. Появятся метки окончания циклов.
Второе. При отладке ставь точки останова и пошагово работай. В этой теме об этом писалось не раз.
1. Уже форматировал так текст, не помогло
2. Код вообще в интерпретатор не загружается, поэтому не могу отладчиком воспользоваться.

Спасибо.
gnuvse вне форума  
 
Непрочитано 29.06.2018, 17:36
1 | #3620
Кулик Алексей aka kpblc
Moderator

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


Если не загружается - значит, в нем полно ошибок синтаксиса.
О форматировании: http://autolisp.ru/2017/08/11/code-f...ng-principles/
Для отладки возьми свой код и вколоти его напрямую в VLIDE. А потом - http://autolisp.ru/2009/09/10/vlide-misc-01/ и http://autolisp.ru/2009/09/12/vlide-misc-02/ (ну так, для справки )
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
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