LISP: GigaChat vs полупрограммист. Чья возьмет?

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

Задача
Итак, задача звучит так:

Необходимо запросить имя файла с расширением CSV и указанием пути его сохранения, а затем открыть его для записи. Необходимо циклично получать данные от пользователя и в конце цикла записывать их в файл одной строкой до тех пор пока первый ввод данных не окажется пустым и затем закрыть файл и завершить работу программы. Во время работы цикла необходимо просить выбрать в текущем чертеже однострочный текст и назвать запрос “введите имя куста”. К полученному из чертежа тексту добавить ; и записать в файл. Попросить пользователя выбрать полилинию и назвать запрос “укажите ндс”. Проверить количество вершин выбранной полилинии и если их больше 2, то сообщить об ошибке и попросить указать другую полилинию. Попросить пользователя выбрать точку на экране с запросом “укажите начало ндс” . Вычислить какая из точек выбранной ранее полилинии ближе всего к выбранной точке и из этой точки поликлиники нарисовать отрезок длинной 10 единиц вертикально вверх. Записать в файл координату x точки из которой был нарисован отрезок и добавить ; Записать в файл координату y точки из которой был нарисован отрезок и добавить ; Вычислить угол между нарисованным отрезком и выбранной полилинией и записать его в файл добавив ; Запись данных во время одного цикла производить в одну строку файла. Удалить нарисованный отрезок. Запустить следующий цикл.

Уже тут возникает масса вопросов. С какого перепугу файл должен быть постоянно открыт? А почему количество вершин должно быть только 2? А что делать с дуговыми сегментами? А что такое “НДС” (надеюсь это не про бухгалтерию)? А зачем рисовать отрезок, если конечные данные можно и так вычислить (а отрезок в конце все равно сносится, и это будет достаточно быстро, чтоб пользователь вообще успел это заметить)? И теде, и тепе.

Кому охота поплакать кровью либо развидеть, добро пожаловать под спойлер ;)

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
;; Функция для открытия файла CSV и получения имени файла
(defun GetCSVFile ()
(setq fileName (getfiled "Select CSV File to Save Data" "" "csv" 16))
(if (= nil fileName)
(progn
(princ "\nNo file selected. Exiting program.")
(exit)
)
)
(open fileName "w")
)

;; Функция для вычисления расстояния между двумя точками
(defun DistanceBetweenPoints (pt1 pt2)
(sqrt (+ (expt (- (car pt2) (car pt1)) 2) (expt (- (cadr pt2) (cadr pt1)) 2)))
)

;; Функция для нахождения ближайшей точки полилинии к заданной точке
(defun FindClosestVertex (pline pt)
(setq plinePts (vlax-safearray->list (vla-get-coordinates (car pline))))
(setq minDist nil)
(foreach vertex plinePts
(setq dist (DistanceBetweenPoints vertex pt))
(if (or (null minDist) (< dist minDist))
(progn
(setq minDist dist)
(setq closestPt vertex)
)
)
)
closestPt
)

;; Основная функция программы
(defun c:MainProgram (/ csvFile outputString textObj polyline ndsPoint closestPt lineStartAngle lineEndAngle)
(vl-load-com)

;; Открываем файл CSV для записи
(setq csvFile (GetCSVFile))

;; Цикл для ввода данных и выполнения операций
(while t
    ;; Просим выбрать однострочный текст
    (setq textObj (entsel "\nSelect single-line text object: "))
    (if (not (and (listp textObj) (= "TEXT" (cdr (assoc 0 (entget (car textObj)))))))
        (progn
            (princ "\nSelected entity is not a single-line text. Please try again.")
            (continue)
        )
    ;; Получаем текст из выбранного объекта
    (setq bushName (cdr (assoc 1 (entget (car textObj)))))
    ;; Добавляем введённый текст в строку вывода
    (setq outputString (strcat bushName ";"))
    ;; Просим выбрать полилинию
    (setq polyline (entsel "\nSelect a polyline for NDS: "))
    (if (not (listp polyline))
        (progn
            (princ "\nInvalid selection. Try again.")
            (continue)
        )
    )
    ;; Проверяем количество вершин полилинии
    (setq plinePts (vlax-safearray->list (vla-get-coordinates (car polyline))))
    (if (<= (length plinePts) 2)
        (progn
            (princ "\nPolyline must have more than two vertices. Select another one.")
            (continue)
        )
    )
    ;; Просим выбрать начальную точку НДС
    (setq ndsPoint (getpoint "\nSpecify the start point of NDS: "))
    ;; Находим ближайшую точку полилинии к указанной точке
    (setq closestPt (FindClosestVertex polyline ndsPoint))
    ;; Рисуем отрезок длиной 10 единиц вверх от ближайшей точки
    (command "_line" closestPt (polar closestPt pi/2 10) "")
    ;; Добавляем координаты начала отрезка в строку вывода
    (setq outputString (strcat outputString (rtos (car closestPt)) ";" (rtos (cadr closestPt)) ";"))
    ;; Вычисляем угол между отрезком и полилинией
    (setq lineStartAngle (angle closestPt (caddr plinePts)))
    (setq lineEndAngle (angle closestPt (cadddr plinePts)))
    (setq angleDiff (abs (- lineStartAngle lineEndAngle)))
    ;; Добавляем угол в строку вывода
    (setq outputString (strcat outputString (rtos angleDiff) ";"))
    ;; Удаляем нарисованный отрезок
    (command "_erase" "_last" "")
    ;; Записываем строку в файл
    (write-line outputString csvFile)
    ;; Продолжаем цикл
    (princ "\nNext iteration...")
)
))

Автор поста жалуется, "как мне не хватает VisualLISP". Эммм... Во-первых, не VisualLisp, а IDE. Во-вторых, с некоторыми натяжками ACAD можно считать трофейным. В-третьих, есть VisualStudioCode и расширение AutoLisp Extension от Autodesk. Еще пара расширений, и становится работать плюс-минус комфортно (конечно, не так, как в ACAD, но жить можно). В четвертыъ, я лично знаю людей, который lisp-код иногда пишут в Notepad++ :)

Первое что я делаю - это все функции перетаскиваю "внутрь". Снаружи их ценность примерно нулевая. Код привожу полностью, чтоб не сходить с ума на ровном месте. Заодно и переименовываю их, предваряя префиксом fun_:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
;; Основная функция программы
(defun c:MainProgram (/ fun_get-csv-file fun_distance-between-two-points fun_ge-closest-vertex csvFile outputString textObj polyline ndsPoint closestPt
                      lineStartAngle lineEndAngle
                     )
  (vl-load-com)

  ;; Функция для открытия файла CSV и получения имени файла
  (defun fun_get-csv-file ()
    (setq fileName (getfiled "Select CSV File to Save Data" "" "csv" 16))
    (if (= nil fileName)
      (progn
        (princ "\nNo file selected. Exiting program.")
        (exit)
      )
    )
    (open fileName "w")
  )

  ;; Функция для вычисления расстояния между двумя точками
  (defun fun_distance-between-two-points (pt1 pt2)
    (sqrt (+ (expt (- (car pt2) (car pt1)) 2) (expt (- (cadr pt2) (cadr pt1)) 2)))
  )

  ;; Функция для нахождения ближайшей точки полилинии к заданной точке
  (defun fun_ge-closest-vertex (pline pt)
    (setq plinePts (vlax-safearray->list (vla-get-coordinates (car pline))))
    (setq minDist nil)
    (foreach vertex plinePts
      (setq dist (fun_distance-between-two-points vertex pt))
      (if (or (null minDist) (< dist minDist))
        (progn
          (setq minDist dist)
          (setq closestPt vertex)
        )
      )
    )
    closestPt
  )

  ;; Открываем файл CSV для записи
  (setq csvFile (fun_get-csv-file))

  ;; Цикл для ввода данных и выполнения операций
  (while t
    ;; Просим выбрать однострочный текст
    (setq textObj (entsel "\nSelect single-line text object: "))
    (if (not (and (listp textObj) (= "TEXT" (cdr (assoc 0 (entget (car textObj)))))))
      (progn
        (princ "\nSelected entity is not a single-line text. Please try again.")
        (continue)
      )
      ;; Получаем текст из выбранного объекта
      (setq bushName (cdr (assoc 1 (entget (car textObj)))))
      ;; Добавляем введённый текст в строку вывода
      (setq outputString (strcat bushName ";"))
      ;; Просим выбрать полилинию
      (setq polyline (entsel "\nSelect a polyline for NDS: "))
      (if (not (listp polyline))
        (progn
          (princ "\nInvalid selection. Try again.")
          (continue)
        )
      )
      ;; Проверяем количество вершин полилинии
      (setq plinePts (vlax-safearray->list (vla-get-coordinates (car polyline))))
      (if (<= (length plinePts) 2)
        (progn
          (princ "\nPolyline must have more than two vertices. Select another one.")
          (continue)
        )
      )
      ;; Просим выбрать начальную точку НДС
      (setq ndsPoint (getpoint "\nSpecify the start point of NDS: "))
      ;; Находим ближайшую точку полилинии к указанной точке
      (setq closestPt (fun_ge-closest-vertex polyline ndsPoint))
      ;; Рисуем отрезок длиной 10 единиц вверх от ближайшей точки
      (command "_line" closestPt (polar closestPt pi/2 10) "")
      ;; Добавляем координаты начала отрезка в строку вывода
      (setq outputString (strcat outputString (rtos (car closestPt)) ";" (rtos (cadr closestPt)) ";"))
      ;; Вычисляем угол между отрезком и полилинией
      (setq lineStartAngle (angle closestPt (caddr plinePts)))
      (setq lineEndAngle (angle closestPt (cadddr plinePts)))
      (setq angleDiff (abs (- lineStartAngle lineEndAngle)))
      ;; Добавляем угол в строку вывода
      (setq outputString (strcat outputString (rtos angleDiff) ";"))
      ;; Удаляем нарисованный отрезок
      (command "_erase" "_last" "")
      ;; Записываем строку в файл
      (write-line outputString csvFile)
      ;; Продолжаем цикл
      (princ "\nNext iteration...")
    )
  )
)

Вспоминаем, что getfiled никогда не возвращает nil, а только пустую строку. Кроме того, сразу открывать файл на запись - ну так себе затея. Учитывая, как NC обрабатывает в лиспе нажатие Esc, я б в функции получал имя, проверял наличие файла (и, если он есть, его сносить), и возвращал имя этого файла. В таком случае код функции получения имени файла становится типа

1
2
3
4
5
6
7
8
9
10
11
;; Функция для открытия файла CSV и получения имени файла
(defun fun_get-csv-file (/ filename)
  (if (/= (setq filename (getfiled "Select CSV File to Save Data" "" "csv" 16)) "")
    (progn
      (if (findfile filename)
        (vl-file-delete filename)
      )
      filename
    )
  )
)

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

1
2
3
4
5
6
(if (setq csvFile (fun_get-csv-file))
  ;; Цикл для ввода данных и выполнения операций
  (while t
    ; ...
  )
)

Если смотреть дальше, то становится совсем уныло. В лиспе нет функции continue. В принципе. Ну или я про нее не знаю. Уже повод задумываться. Пока оставлю условие цикла "на потом", и просто посмотрю что там внутри цикла вообще находится:

1
2
3
4
5
6
7
8
9
10
(if (not (and (listp textObj) (= "TEXT" (cdr (assoc 0 (entget (car
  (progn
    (princ "\nSelected entity is not a single-line text. Please try again")
    (continue)
  )
  ;; Получаем текст из выбранного объекта
  (setq bushName (cdr (assoc 1 (entget (car textObj)))))
  ;; Добавляем введённый текст в строку вывода
  (setq outputString (strcat bushName ";"))
  ;; Просим выбрать полилинию

Э, стоп! А где progn на вторую ветку? GigaChat, похоже, про это не в курсе от слова совсем. Еще б код работал...

Так, теперь сама организация цикла: while t -> выбрать, проверить, бла-бла-бла... Значительно проще и дешевле в условие while засунуть получение (и проверку) всех необходимых примитивов и точек (кстати, количество вершин идет лесом):

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
(while
  (and
    (=
      (type
        (setq textObj (vl-catch-all-apply
                        (function
                          (lambda ()
                            (car (entsel "\nSelect text <Cancel> : "))
                          )
                        )
                      )
        )
      )
      'ename
    )
    (= (cdr (assoc 0 (entget textObj))) "TEXT")
    (setq bushName (cdr (assoc 1 (entget textObj))))
    (=
      (type
        (setq polyline (vl-catch-all-apply
                         (function
                           (lambda ()
                             (car (entsel "\nSelect polyline for NDS <Cancel> : "))
                           )
                         )
                       )
        )
      )
      'ename
    )
    (= (cdr (assoc 0 (entget polyline))) "LWPOLYLINE")
    (=
      (type
        (setq ndsPoint (vl-catch-all-apply
                         (function
                           (lambda ()
                             (getpoint "\nSpecify the start point of NDS <Cancel> : ")
                           )
                         )
                       )
        )
      )
      'lisp
    )
    ndsPoint
  )
;; ...
)

Тут уже сразу если что-то пошло не так, моментально не влезаем в цикл. Теперь сам цикл. Понятно, что строки типа "Если тип примитива не текст / полилиния", уже идут далеко и без хлеба. Считаю, что все возможные данные от пользователя уже получены и они как минимум корректны:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
(setq outputString (strcat bushName ";"))
;; Находим ближайшую точку полилинии к указанной точке
(setq closestPt (fun_ge-closest-vertex polyline ndsPoint))
;; Рисуем отрезок длиной 10 единиц вверх от ближайшей точки
(command "_line" closestPt (polar closestPt pi/2 10) "")
;; Добавляем координаты начала отрезка в строку вывода
(setq outputString (strcat outputString (rtos (car closestPt)) ";" (rtos (cadr closestPt)) ";"))
;; Вычисляем угол между отрезком и полилинией
(setq lineStartAngle (angle closestPt (caddr plinePts)))
(setq lineEndAngle (angle closestPt (cadddr plinePts)))
(setq angleDiff (abs (- lineStartAngle lineEndAngle)))
;; Добавляем угол в строку вывода
(setq outputString (strcat outputString (rtos angleDiff) ";"))
;; Удаляем нарисованный отрезок
(command "_erase" "_last" "")
;; Записываем строку в файл
(write-line outputString csvFile)
;; Продолжаем цикл
(princ "\nNext iteration...")

И вот тут начинается самое интересное...

Первое. Ближайшая точка далеко не всегда вершина. А fun_get-closest-vertex (сорян, выше опечатался) напрямую запрашивает вершину. Это видно и по названию, и по коду. Но у нас-то по условию - ближайшая точка! Забуду про разные системы координат, считаю, что вся работа ведется в МСК (кому охота заморачиваться - останавливать не буду).

Так что функция fun_get-closest-vertex отправляется глубоко и далеко и вместо нее использую vlax-curve-getclosestpointto (благо в нее можно передавать и vla-, и ename-указатели, насколько я помню):

1
(setq closestPt (vlax-curve-getclosestpointto polyline ndsPoint))

Далее. "Рисуем отрезок". Че, серьезно? Командными методами? Не снимая привязки? А зачем вообще нужен этот отрезок? Только для вычисления угла наклона в ближайшей точке? Пшловсенах, делаю "по наклону в точке". Вспоминаю школьную геометрию, производные хотя бы первого порядка - и получается, что для вычисления угла наклона касательной достаточно взять первую производную. Так что все эти построения и вычисления углов моментально превращаются в нечто типа

1
2
3
(setq closestPt (vlax-curve-getclosestpointto polyline ndsPoint)
      angleDiff (- (* pi 0.5) (vlax-curve-getfirstderiv polyline closestPt))
)

Если что, я объединил несколько setq в одну - и работает быстрее, и читается слегка попроще (как мне кажется).

О, пока не забыл: функция вычисления ближайшей вершины отправляется погулять. Далеко и надолго. Примерно навсегда. Как она была написана - отдельная песня, ну да и бог с ней.

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

1
2
3
4
5
6
7
8
; Пример вызова
(fun-save-to-file
  csvFile
  (list (cons "text" bushName)
        (cons "point" closestPt)
        (cons "angle" angleDiff)
  )
)

И собственно функция записи:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
(defun fun_save-to-file (filename param-list / delim str)
  (setq delim  ";"
        str    (strcat (cdr (assoc "text" param-list))
                       delim
                       (apply (function strcat)
                              (mapcar
                                (function
                                  (lambda (x)
                                    (strcat (rtos x 2 14) delim)
                                  )
                                )
                                (mapcar (function+)
                                        '(0. 0.)
                                        (cdr (assoc "point" param-list))
                                )
                              )
                       )
                       (rtos (cdr (assoc "angle" param-list)))
               )
        handle (open filename "a")
  )
  (write-line str handle)
  (close handle)
)

И в результате код становится наподобие

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
;; Основная функция программы
(defun c:MainProgram (/ fun_get-csv-file fun_save-to-file csvFile textObj polyline ndsPoint closestPt angleDiff)
  (vl-load-com)

  ;; Функция для открытия файла CSV и получения имени файла
  (defun fun_get-csv-file (/ filename)
    (if (/= (setq filename (getfiled "Select CSV File to Save Data" "" "csv" 16)) "")
      (progn
        (if (findfile filename)
          (vl-file-delete filename)
        )
        filename
      )
    )
  )

  ;; Выполняет запись полученных данных в файл
  (defun fun_save-to-file (filename param-list / delim str)
    (setq delim  ";"
          str    (strcat (cdr (assoc "text" param-list))
                         delim
                         (apply (function strcat)
                                (mapcar
                                  (function
                                    (lambda (x)
                                      (strcat (rtos x 2 14) delim)
                                    )
                                  )
                                  (mapcar (function+)
                                          '(0. 0.)
                                          (cdr (assoc "point" param-list))
                                  )
                                )
                         )
                         (rtos (cdr (assoc "angle" param-list)))
                 )
          handle (open filename "a")
    )
    (write-line str handle)
    (close handle)
  )

  (if (setq csvFile (fun_get-csv-file))
    ;; Цикл для ввода данных и выполнения операций
    (while
      (and
        (=
          (type
            (setq textObj (vl-catch-all-apply
                            (function
                              (lambda ()
                                (car (entsel "\nSelect text <Cancel> : "))
                              )
                            )
                          )
            )
          )
          'ename
        )
        (= (cdr (assoc 0 (entget textObj))) "TEXT")
        (=
          (type
            (setq polyline (vl-catch-all-apply
                             (function
                               (lambda ()
                                 (car (entsel "\nSelect polyline for NDS <Cancel> : "))
                               )
                             )
                           )
            )
          )
          'ename
        )
        (= (cdr (assoc 0 (entget polyline))) "LWPOLYLINE")
        (=
          (type
            (setq ndsPoint (vl-catch-all-apply
                             (function
                               (lambda ()
                                 (getpoint "\nSpecify the start point of NDS <Cancel> : ")
                               )
                             )
                           )
            )
          )
          'lisp
        )
        ndsPoint
      )

      (setq closestPt (vlax-curve-getclosestpointto polyline ndsPoint)
            angleDiff (- (* pi 0.5) (vlax-curve-getfirstderiv polyline closestPt))
      )

      (fun-save-to-file
        csvFile
        (list (cons "text" (cdr (assoc 1 (entget textObj))))
              (cons "point" closestPt)
              (cons "angle" angleDiff)
        )
      )
      ;; Продолжаем цикл
      (princ "\nNext iteration...")
    )
  )
  (princ)
)

Работоспособность не проверял, поскольку как минимум есть вопросы к ТЗ и ожидаемому поведению.



Поделитесь своим мнением


Я не робот.