Научите лиспу на примере (или как 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

_____________________________________________________________________________________________________________

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

Кулик Алексей aka kpblc · 18.11.2010, 22:51

Код:

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

(defun get-point-or-columns (/ pt gr res)
  (if (= (type (setq pt (vl-catch-all-apply
                          (function
                            (lambda ()
                              (getpoint "\nБазовая точка <Отмена> : ")
                              ) ;_ end of lambda
                            ) ;_ end of function
                          ) ;_ end of vl-catch-all-apply
                     ) ;_ end of setq
               ) ;_ end of type
         'list
         ) ;_ end of =
    (progn
      (initget "К _ R")
      (if
        (member (type
                  (setq
                    res (vl-catch-all-apply
                          (function
                            (lambda () (getpoint pt "\nТочка вставки перечня кабелей [Количество столбцов] <Отмена> : "))
                            ) ;_ end of function
                          ) ;_ end of vl-catch-all-apply
                    ) ;_ end of setq
                  ) ;_ end of type
                (list 'list 'str)
                ) ;_ end of member
         (cond
           ((= res "R")
            (if (/= (type (setq res (vl-catch-all-apply (function (lambda ()
                                                                    (initget 5)
                                                                    (getint "\nКоличество столбцов <Отмена> : ")
                                                                    ) ;_ end of lambda
                                                                  ) ;_ end of function
                                                        ) ;_ end of vl-catch-all-apply
                                ) ;_ end of setq
                          ) ;_ end of type
                    'int
                    ) ;_ end of /=
              (setq res nil)
              ) ;_ end of if
            )
           ) ;_ end of cond
         (setq res nil)
         ) ;_ end of if
      ) ;_ end of progn
    ) ;_ end of if
  res
  ) ;_ end of defun

Michael! · 18.11.2010, 23:55

Доброго времени суток!
Вот написал программку, суть которой скопировать объект на рассчитанное предварительно расстояние и после скопированному объекту надо сделать stretch с каждой стороны. делаю выделение, а он его (этот объект не видит).

Код:

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

(command "stretch" "Crossing" stretch_point_r_up stretch_point_r-down "" "10,10" umenshenye_right)
(command "stretch" "Crossing" stretch_point_l_up stretch_point_l-down "" "10,10" umenshenye_left)

Когда запускаю прогу повторно, предидущий объект становится видимым. (stretch выполняется)
Видимо "свежескопированный" объект не видим для stretch.
помогите, как сделать чтобы заработала прога

Frigate · 19.11.2010, 06:03

Кулик Алексей aka kpblc,

Алексей, БРАВО :-)

Сразу видно мастера ЛИСПа. А то я тут через Камчатку в Москву всю видимо пытаюсь ехать

А можешь код модифицировать так, чтобы после указания количества столбцов пользователь уже выбрал точку вставки?

Только объясни мне, пожалуйста, какой кусок кода отвечает за прорисовку временной линии от первой точки до точки вставки перечня кабелей?

Кстати, я не увидел в коде локальной переменной gr...

Добавлено:

Я понял, Алексей, как теперь сделать

Благодарю за просвещение :-)

А то я что-то плохо очень знал возможности getpoint. Зато полез в дебри grread

В общем вывод - изучать возможности основных функций АвтоЛиспа.

Li6-D · 19.11.2010, 18:54

Цитата:

Сообщение от Michael!

....Видимо "свежескопированный" объект не видим для stretch. помогите, как сделать чтобы заработала прога

Наверное объект тоже создан командными методами (с помощью функций command или vl-cmdf). Предыдущая команда выполнена, а новый примитив не добавлен в БД чертежа (на подходе). Autolisp не проверяет завершение процесса и приступает к следующей команде stretch. Чтобы задуманная последовательность действий сохранялась, командные программисты между командами обычно вставляют "костыль" - запрос, который должен надолго озадачить пользователя, например (getstring "\nТы абсолютно уверен, что хочешь обрезать объект? ")

В этом - минус командных методов. Полноценное решение задачи - с помощью технологии ActiveX.

Michael! · 19.11.2010, 19:54

to Li6-D
да. да. именно так и происходит. я получаю этот объект посредством копирования пред идущего.
Подскажи, а как это реализовать через ActiveX ?
задача в общем-то такая: нужно выбранный объект скопировать, перетащить в другой слой и сделать уже перетащенному stretch с двух сторон на заданное расстояние. А потом тоже самое сделать с полученным после трима объектом.
Спасибо!

Li6-D · 19.11.2010, 20:05

Michael!,
К сожалению помочь не смогу, так как сам такой

и не знаю ActiveX.
А вообще данных сообщено маловато. Код скуп, копируемый объект неизвестен.

Michael! · 19.11.2010, 20:12

А может есть какаянибудь команда на регенерацию и внесение в базу чертежа новых объектов?

Кулик Алексей aka kpblc · 20.11.2010, 00:39

Frigate, просто можно повторно запросить точку в случае выбора "Количество столбцов", это не сложно. Я-то полной задачи не знаю, потому такой код и нарисовал.
Michael!, я не очень понял. Есть исходный объект:
(setq ent (car (entsel)))
Потом он копируется:
(command "_.copy" ent "" pause pause)
А потом к нему выполняется _.stretch:
(command "_.stretch" (entlast) <...>)
Так?
Можно вариант переделать (пишу без проверок):

Код:

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

(if (and (setq ent (car (entsel)))
         (vl-cmdf "_.copy" ent "" pause pause)
         ) ;_ end of and
  (progn
    (if (not (vl-cmdf "_.stretch" (entlast) <...>))
      (command "_.undo")
      (if (not (vl-cmdf "_.stretch" (entlast) <...>))
        (command "_.undo")
        ) ;_ end of if
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if

Только вот проблема: если пользователь нажмет Esc или правую кнопку мыши, результат _.stretch может оказаться непредсказуемым. Я не помню точно, на какой версии я с этим обжегся, но сейчас я бы всерьез задумался о полностью программном изменении примитива. В результате дешевле выйдет.

Michael! · 20.11.2010, 01:19

to Кулик Алексей aka kpblc
А поясните пожалуйста строки вашего кода.
entsel, я не пользовал ни разу.
задумка у меня такая:

Код:

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

(defun c:c1 ()

(command "setvar" "osmode" 675) ; snapon
(setq point_x1_y1 (getpoint "\n Lowest left point -->"))
(setq point_x2_y2 (getpoint "\n Highest right point -->"))
(setq um 15)
(command "setvar" "osmode" 17059) ;snapoff

(setq x1 (car point_x1_y1))
(setq y1 (cadr point_x1_y1))
(setq x2 (car point_x2_y2))
(setq y2 (cadr point_x2_y2))

(setq copy_point_r_up (strcat (rtos (+ x2 2) 2) "," (rtos (- y2 2) 2)))
(setq copy_point_l_down (strcat (rtos (- x1 2) 2) "," (rtos (+ y1 2) 2)))

(setq dista (+ (- x2 x1) 300))

(setq x2new (strcat (rtos (- x2 dista) 2) "," (rtos y2 2)))
(setq x1new (strcat (rtos (- x1 dista) 2) "," (rtos y2 2)))

(setq point_new_r_up (strcat (rtos (+ (- x2 dista) 2) 2) "," (rtos (- y2 2) 2)))
(setq point_new_l_down (strcat (rtos (- (- x1 dista) 2) 2) "," (rtos (+ y1 2) 2)))

(command "copy" "w" copy_point_r_up copy_point_l_down "" point_x2_y2 x2new)

;(command "_.change" "w" point_new_r_up point_new_l_down "" "p" "layer" "tm8" "")

(command "_.change" (ssget "_l") "" "p" "layer" "tm8" "")

(setq x1 (- x1 dista))
(setq x2 (- x2 dista))

(setq point_l (+(* (- x2 x1) 0.33333) x1))
(setq point_r (+(* (- x2 x1) 0.66666) x1))

(setq stretch_point_r_up (strcat (rtos (+ x2 2) 2) "," (rtos (- y2 2) 2)))
(setq stretch_point_r-down (strcat (rtos point_r 2) "," (rtos (+ y1 2) 2)))

(setq stretch_point_l_up (strcat (rtos point_l 2) "," (rtos (- y2 1) 2)))
(setq stretch_point_l-down (strcat (rtos (- x1 2) 2) "," (rtos (+ y1 2) 2)))

(setq umenshenye_right (strcat "@-" (rtos um) "," "0"))
(setq umenshenye_left (strcat "@" (rtos um) "," "0"))

(command "stretch" "Crossing" stretch_point_r_up stretch_point_r-down "" "10,10" umenshenye_right)
(command "stretch" "Crossing" stretch_point_l_up stretch_point_l-down "" "10,10" umenshenye_left)

(command "setvar" "osmode" 675) ; snapon

); end defun c:c1

выделить объект, скопировать его на заданное расстояние, переместить в другой слой, сделать ему стретч с двух сторон. потом с полученным объектом проделать тоже самое. Это в общем суть этой функции. А эта функция работает в цикле, в котором задается какое количество раз нужно проделать эти операции над объектом и насколько ему нужно делать stretch.

Li6-D · 20.11.2010, 19:36

Michael!,
Много буков, а леса не видно. Опять фрактальные построения что ли? Наведу критику:
1) Не объявлены локальные переменные (хотя сойдет для отладки). Создана команда, а не функция.
Если она не вызывается юзером, а используется другой функцией, то незачем ее делать командой.
2) Почитай про функцию setvar.
3) Зачем строковое представление точек? Точки-списки нормально воспринимаются в command-функции.
4) Если нужно получить точку, смещенную на определенный вектор относительно исходной можно написать:
(setq Pt1 (mapcar '+ Pt0 '(-2 2 0))), где '(-2 2 0) - вектор смещения.
Если есть две точки Pt0, Pt и надо найти точку Pt1 на отрезке их соединяющем и
делящую этот отрезок в заданной пропорции. Варианты решения:
(setq Pt1 (polar Pt0 (angle Pt0 Pt) (/ (distance Pt0 Pt) 3)))
(setq Pt1 (mapcar '(lambda (x y) (/ (+ x x y) 3)) Pt0 Pt))
5) Ни одного примитива код не создает, какого рода объекты копируются?
Если примитивы простые, то может их проще создавать entmake, а не копировать.
6) Пиши так: (command "_.stretch" "_Crossing"... ) - у многих стоит локализованная версия.

Michael! · 20.11.2010, 19:55

согласен.
1. они будут объявлены позже. пока она вызывается именно так. поэтому я и написал что С:
2. почитаю

3. так понятнее для меня было - исправлю.
4. не знал что так можно/нужно делать
5. копируются полилинии замкнутые
6. тут я для себя пишу. на моем компе и так работает.

так всетаки, как сделать смену слоя и stretch для полученного объекта?

Кулик Алексей aka kpblc · 20.11.2010, 22:33

Michael!, я так и не понял конечного смысла использования _.stretch (кстати, код не будет работать в русской версии). Что, надо переместить объект вправо-влево? Приложи dwg-файл, с которым работаешь. Точнее, интересны объекты, над которыми выполняются настолько непонятные операции.

Michael! · 20.11.2010, 23:15

to Кулик Алексей aka kpblc
вот приложил файлик-пример. Объекты - это полилинии. Невсегда симметричные, разных размеров. Это контуры объектов.
Работаю я в 2004 autocad английской версии. Поэтому работоспособность для русских версий я не рассматриваю.

Кулик Алексей aka kpblc · 20.11.2010, 23:42

В качестве первого прикидочного варианта:

Код:

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

(vl-load-com)

(defun c:copy-and-modify (/ adoc ent layer coords new_coords new_point)

  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (if (and (= (type (setq ent (vl-catch-all-apply
                                (function
                                  (lambda ()
                                    (ssname (ssget "_+.:S:E" '((0 . "LWPOLYLINE") (90 . 4))) 0)
                                    ) ;_ end of lambda
                                  ) ;_ end of function
                                ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'ename
              ) ;_ end of =
           (setq coords (vl-sort
                          (mapcar (function cdr)
                                  (vl-remove-if-not
                                    (function
                                      (lambda (x)
                                        (= (car x) 10)
                                        ) ;_ end of lambda
                                      ) ;_ end of function
                                    (entget ent)
                                    ) ;_ end of vl-remove-if-not
                                  ) ;_ end of mapcar
                          (function
                            (lambda (a b)
                              (< (car a) (car b))
                              ) ;_ end of lambda
                            ) ;_ end of function
                          ) ;_ end of vl-sort
                 ) ;_ end of setq
           (= (type (setq new_point (vl-catch-all-apply
                                      (function
                                        (lambda ()
                                          (getpoint
                                            (car coords)
                                            "\nНовая точка вставки <Отмена> : "
                                            ) ;_ end of getpoint
                                          ) ;_ end of lambda
                                        ) ;_ end of function
                                      ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'list
              ) ;_ end of =
           new_point
           (= (type (setq step (vl-catch-all-apply
                                 (function
                                   (lambda ()
                                     (initget 3)
                                     (/ (getdist "\nВведите уменьшение <Отмена> : ") 2.)
                                     ) ;_ end of lambda
                                   ) ;_ end of function
                                 ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'real
              ) ;_ end of =
           (= (type (setq layer (vl-catch-all-apply
                                  (function
                                    (lambda (/ res)
                                      (cond
                                        ((= (setq res (getstring "\nНовое имя слоя <Текущий> : ")) "")
                                         (getvar "clayer")
                                         )
                                        (t res)
                                        ) ;_ end of cond
                                      ) ;_ end of lambda
                                    ) ;_ end of function
                                  ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'str
              ) ;_ end of =
           ) ;_ end of and
    (progn
      (setq new_coords (mapcar
                         (function
                           (lambda (x)
                             (list (+ (car x)
                                      (car new_point)
                                      (- (caar coords))
                                      (* step
                                         (if (< (vl-position x coords) (/ (length coords) 2))
                                           1
                                           -1
                                           ) ;_ end of if
                                         ) ;_ end of *
                                      ) ;_ end of +
                                   (+ (cadr x) (cadr new_point) (- (cadar coords)))
                                   ) ;_ end of list
                             ) ;_ end of lambda
                           ) ;_ end of function
                         coords
                         ) ;_ end of mapcar
            ) ;_ end of setq
      (entmakex (append
                  (vl-remove-if
                    (function
                      (lambda (x)
                        (member (car x) '(-1 5 330 300 10))
                        ) ;_ end of lambda
                      ) ;_ end of function
                    (subst (cons 8 layer) (assoc 8 (entget ent)) (entget ent))
                    ) ;_ end of vl-remove-if
                  (mapcar
                    (function
                      (lambda (x)
                        (cons 10 x)
                        ) ;_ end of lambda
                      ) ;_ end of function
                    new_coords
                    ) ;_ end of mapcar
                  ) ;_ end of append
                ) ;_ end of entmakex
      ) ;_ end of progn
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

Michael! · 20.11.2010, 23:48

to Кулик Алексей aka kpblc
спасибо огромное!
А можно с пояснениями чуть чуть. Хочу разобраться всетаки что к чему. Не понял как она делает уменьшение.
Уменьшение происходит только с одной стороны. хотелось бы уменьшать на одинаковое расстояние с двух сторон. причем stretch делать с 1/3 длины объекта

Кулик Алексей aka kpblc · 21.11.2010, 00:03

А "треть длины" - это по какому направлению считать?
Offtop: Код сделан был только для того случая, который был представлен.

Michael! · 21.11.2010, 00:13

вот в приложенном файле я обозначил области

Кулик Алексей aka kpblc · 21.11.2010, 22:33

А как изменять верхнюю часть?
Вообще-то я бы, наверное, сделал просто блок и его вставлял с разными масштабами по разным осям. Может, неэтично, зато дешево, надежно и практично

---
Добавлено:

Сначала формируем набор:
Код:
[Выделить все]
```
(ssget "_+.:S:E" '((0 . "LWPOLYLINE") (90 . 4)))
```
Сразу указывается, что может быть выбран только один примитив, только внутри прицела, что этот примитив LWPOLYLINE и в нем 4 вершины. По идее можно добавить еще и флаг замкнутости, но это я делать поленился
Следом получаем из него первый (он же единственный) примитив:
Код:
[Выделить все]
```
(ssname (ssget "_+.:S:E" '((0 . "LWPOLYLINE") (90 . 4))) 0)
```

"Обертываем" все в отлов ошибок (ведь юзер может запросто нажать Esc):

Код:

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

(vl-catch-all-apply
                                (function
                                  (lambda ()
                                    (ssname (ssget "_+.:S:E" '((0 . "LWPOLYLINE") (90 . 4))) 0)
                                    ) ;_ end of lambda
                                  ) ;_ end of function
                                ) ;_ end of vl-catch-all-apply

Если тип возвращаемого этой конструкцией значения ename
Код:
[Выделить все]
```
 (= (type (setq ent (vl-catch-all-apply <...>))) 'ename)
```
То выбор был сделан и сделан корректно. Сразу после этого получаем координаты полилинии:

Код:

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

                 (mapcar (function cdr)
                                  (vl-remove-if-not
                                    (function
                                      (lambda (x)
                                        (= (car x) 10)
                                        ) ;_ end of lambda
                                      ) ;_ end of function
                                    (entget ent)
                                    ) ;_ end of vl-remove-if-not
                                  ) ;_ end of mapcar

Получаем через entget DXF-представление примитива, убираем все точечные пары, у которых ключ не 10, и применяем к ним функцию cdr.

И сразу сортируем:

Код:

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

           (setq coords (vl-sort
                          (mapcar (function cdr)
                                  (vl-remove-if-not
                                    (function
                                      (lambda (x)
                                        (= (car x) 10)
                                        ) ;_ end of lambda
                                      ) ;_ end of function
                                    (entget ent)
                                    ) ;_ end of vl-remove-if-not
                                  ) ;_ end of mapcar
                          (function
                            (lambda (a b)
                              (< (car a) (car b))
                              ) ;_ end of lambda
                            ) ;_ end of function
                          ) ;_ end of vl-sort
                 ) ;_ end of setq

по возрастанию значения X координаты.

После этого получаем новую точку, куда надо будет вставлять измененную копию примитива, оборачивая ее в vl-catch-all-apply:

Код:

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

           (= (type (setq new_point (vl-catch-all-apply
                                      (function
                                        (lambda ()
                                          (getpoint
                                            (car coords)
                                            "\nНовая точка вставки <Отмена> : "
                                            ) ;_ end of getpoint
                                          ) ;_ end of lambda
                                        ) ;_ end of function
                                      ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'list
              ) ;_ end of =

Абсолютно аналогично первому шагу. По тому же алгоритму получаем уменьшение и имя слоя:

Код:

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

           (= (type (setq step (vl-catch-all-apply
                                 (function
                                   (lambda ()
                                     (initget 3)
                                     (/ (getdist "\nВведите уменьшение <Отмена> : ") 2.)
                                     ) ;_ end of lambda
                                   ) ;_ end of function
                                 ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'real
              ) ;_ end of =
           (= (type (setq layer (vl-catch-all-apply
                                  (function
                                    (lambda (/ res)
                                      (cond
                                        ((= (setq res (getstring "\nНовое имя слоя <Текущий> : ")) "")
                                         (getvar "clayer")
                                         )
                                        (t res)
                                        ) ;_ end of cond
                                      ) ;_ end of lambda
                                    ) ;_ end of function
                                  ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'str
              ) ;_ end of =

И только в том случае, если все выбрано и указано верно, начинаем собственно работу. Для начала модифицируем координаты:

Код:

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

      (setq new_coords (mapcar
                         (function
                           (lambda (x)
                             (list (+ (car x)
                                      (car new_point)
                                      (- (caar coords))
                                      (* step
                                         (if (< (vl-position x coords) (/ (length coords) 2))
                                           1
                                           -1
                                           ) ;_ end of if
                                         ) ;_ end of *
                                      ) ;_ end of +
                                   (+ (cadr x) (cadr new_point) (- (cadar coords)))
                                   ) ;_ end of list
                             ) ;_ end of lambda
                           ) ;_ end of function
                         coords
                         ) ;_ end of mapcar
            ) ;_ end of setq

И после этого создаем новый примитив, удаляя точечные пары с ключами 1, 5, 330 и заменяя группы 10.
После этого ставим метки начала и конца отмены и не забываем про (vl-load-com). Код готов

Michael! · 22.11.2010, 01:10

круто! спасибо за разъяснения.
на счет вставки блока с разными масштабами по осям - интересная мысль.
а как копировать и вставлять блок. ведь после вставки вновь появившийся объект опять не будет виден программе.
потом, не хотелось бы трогать 2/3 середины, а уменьшать только по 1/3 с краев фигур. (кстати, формы бывают абсолютно разные. Не обязательно это многоугольник. это может быть совокупность дуг и отрезков.
пробовал свой код с "костылем" по методу Li6-D - не помогает. Всеравно после него объект не виден.

ShaggyDoc · 22.11.2010, 07:23

Цитата:

вот приложил файлик-пример. Объекты - это полилинии. Невсегда симметричные, разных размеров. Это контуры объектов.

И зачем здесь STRETCH? Показаны всего лишь трапеции. Пусть несимметричные, пусть разных размеров, с разными углами наклонов и т.п.

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

Вот примеры:

Код:

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

(defun ru-draw-trapezium-by-side (start_pnt      ang
                                  len            start_left_len
                                  start_right_len
                                  end_left_len   end_right_len
                                  lineweight     /
                                  end_pnt
                                 )
  ;; трапеция по стороне
;;;(ru-draw-trapezium-by-side (getpoint "Начало патрубка:") 0 500 100.0 100.0 100.0 100.0 0)  
  (setq end_pnt (polar start_pnt ang len)) ;_ end of setq
  (ru-line-add-multi
    (list

          (polar end_pnt (ru-geom-go-left ang) end_left_len) 
          (polar end_pnt (ru-geom-go-right ang) end_right_len) 
          (polar start_pnt (ru-geom-go-right ang) start_right_len)
          (polar start_pnt (ru-geom-go-left ang) start_left_len)
    ) ;_ end of list
    t
    lineweight
    nil
  ) ;_ end of 
  (princ)
)

(defun ru-draw-trapezium-by-center (start_pnt      ang
                                    len            start_left_len
                                    start_right_len
                                    end_left_len   end_right_len
                                    lineweight     /
                                    end_pnt
                                   )
  ;; трапеция с заданным центром
;;;(ru-draw-trapezium-by-center (getpoint "Центр трапеции:") 0 500 100.0 200.0 150.0 250.0 50)  
  (ru-draw-trapezium-by-side
    (polar start_pnt (ru-geom-go-back ang) (/ len 2))
    ang
    len
    start_left_len
    start_right_len
    end_left_len
    end_right_len
    lineweight
  ) ;_ end of ru-draw-trapezium-by-side
  (princ)
)

Не привожу ru-line-add-multi - рисование кучи отрезков по списку точек (можно заменить командой). Ну и элементарные функции для определения углов (направлений) от заданного угла:

Код:

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

(defun ru-geom-go-back (u)
  (+ u pi)
)
(defun ru-geom-go-left (u)
  (+ u (/ pi 2))
)

(defun ru-geom-go-right (u)
  (- u (/ pi 2))
)

которые тоже тысячи раз применяются.

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

	Реклама i