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

_____________________________________________________________________________________________________________

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

gomer · 25.08.2014, 12:59

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

Vladimir_Sergeevich · 25.08.2014, 14:15

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

Кулик Алексей aka kpblc · 25.08.2014, 14:22

Я несколько раз пытался понять, чего надо получить... Оказалось выше моего понимания. Может, такой код будет более устойчивым (код из #2231 у меня работал "как бог на душу положит"):

Код:

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

 (vl-load-com)

(defun c:pk1 (/ adoc curve_axe pt ins_pt rot_pt)

  (defun fun_get-objid (obj id)
    (if (> (vl-string-search "x64" (getvar "platform")) 0)
      (vla-objectidtoobject32 obj id)
      (vla-objectidtoobject obj id)
      ) ;_ end of if
    ) ;_ end of defun

  (if (and (= (type (setq curve_axe (vl-catch-all-apply
                                      (function
                                        (lambda ()
                                          (vlax-ename->vla-object (car (entsel "\nУкажите ось <Отмена> : ")))
                                          ) ;_ end of lambda
                                        ) ;_ end of function
                                      ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'vla-object
              ) ;_ end of =
           (member (type (setq pt (vl-catch-all-apply
                                    (function
                                      (lambda (/ res)
                                        (initget 135) ; "Другая Other _ Д O")
                                        (setq res (getpoint "\nУкажите точку <Другая ось> : "))
                                        (if
                                          (= (type res) 'str)
                                           (setq res (car (entsel "\nДругая ось <Отмена> : ")))
                                           ) ;_ end of if
                                        res
                                        ) ;_ end of lambda
                                      ) ;_ end of function
                                    ) ;_ end of vl-catch-all-apply
                               ) ;_ end of setq
                         ) ;_ end of type
                   (list 'list 'ename)
                   ) ;_ end of member
           ) ;_ end of and
    (progn
      (if (= (type pt) 'ename)
        (progn
          (setq curve_axe (vlax-ename->vla-object pt)
                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 progn
        ) ;_ end of if
      (if (and (= (type pt) 'list)
               (= (type (setq ins_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 =
               (= (type (setq rot_pt (vl-catch-all-apply
                                       (function
                                         (lambda ()
                                           (cond
                                             ((getangle ins_pt "\nУгол поворота текста <0.0> : "))
                                             (t 0.0)
                                             ) ;_ end of cond
                                           ) ;_ end of lambda
                                         ) ;_ end of function
                                       ) ;_ end of vl-catch-all-apply
                              ) ;_ end of setq
                        ) ;_ end of type
                  'real
                  ) ;_ end of =
               ) ;_ end of and
        (progn
          (vla-put-rotation (vla-addtext
                              (fun_get-objid (vla-get-activedocument (vlax-get-acad-object))
                                             (vla-get-ownerid curve_axe)
                                             ) ;_ end of fun_get-objid
                              (strcat "+"
                                      (rtos (rem (setq pt (vlax-curve-getdistatpoint
                                                            curve_axe
                                                            (vlax-curve-getclosestpointto curve_axe pt)
                                                            ) ;_ end of vlax-curve-getDistAtPoint
                                                       ) ;_ end of setq
                                                 ) ;_ end of rem
                                            ) ;_ end of rtos
                                      ) ;_ end of strcat
                              (vlax-3d-point ins_pt)
                              (getvar "textsize")
                              ) ;_ end of vla-addtext
                            rot_pt
                            ) ;_ end of vla-put-Rotation
          (princ (strcat "\nПоложение точки относительно оси = " (rtos pt 2 2)))
          ) ;_ end of progn
        ) ;_ end of if
      ) ;_ end of progn
    ) ;_ end of if
  (princ)
  ) ;_ end of defun

Vladimir_Sergeevich · 25.08.2014, 15:19

мать моя женщина... Алексей, я десятка 2 привязок посадил - ничего не увидел странного... а твой шедевр я еще месяц раскуривать буду

поясни, что ты имел ввиду под "бог на душу", представить не могу, желательно с пояснениями что и зачем добавлено.

Кулик Алексей aka kpblc · 25.08.2014, 15:59

Vladimir_Sergeevich, у меня твой код через раз на ровном месте (то при попытке выбора первой оси, то при попытке ввода точки) выдавал ошибку. Кстати, я у себя тож одну ошибку нашел (уже исправил). А логика-то работы проста как 3 копейки:
1. Получаем первую ось. Если пользователь нажал Esc или правую кнопку (то есть ни шиша не выбрал), то просто уходим с выполнения
2. Дальше аналогично запрашивается вторая точка. Если пользователь нажал правую кнопку, то вместо точки запрашивается "вторая ось".
3. Дальше, если в п.2 выл выбран объект (а не точка), повторно запрашиваем точку. Заодно гарантированно преобразовываем объекты в ActiveX (можно было и в другом месте это сделать, но я оставил как есть - писалось-то все "на коленке")
4. По полной аналогии с п.1 запрашиваем точку вставки и угол поворота текста.
5. Вставляем текст в пространство, в котором находится "ось".

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

P.S. По-хорошему надо бы контролировать тип примитивов "осей", но мне уже лениво

seregabs · 04.09.2014, 20:48

Просмотрел много тем про работу с атрибутами блоков. С тем, как в лиспе присваивать им новые значения, примерно понял. Но не могу этого проверить для своих нужд. А именно:

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

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

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

Код:

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

(setq krd (getpoint "\n Введите точку вставки:"))

и получаю в переменной krd координаты точки, лежащей на блоке рамки. На следующих этапах эта переменная меняется приращениями, поэтому я ее дублирую:

Код:

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

(setq krdramka krd)

Сразу вопрос - так можно координаты присвоить новой переменной?
И далее мне нужно обратиться к атрибуту блока с известным названием и известной точкой, лежащей на нем.
Можно ли определить нужный блок вот так:

Код:

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

(setq ramka (vlax-ename->vla-object 
  (ssget '(krdramka) '((0 . "INSERT") (2 . "название_блока")))
     ))

Дима_ · 04.09.2014, 21:25

Цитата:

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

Загвоздка вышла с тем, как обратиться к атрибуту именно того блока, на который был сделан клик.

результат функции (entsel ...) содержит как точку указания, так и ename выбранного блока.

seregabs · 04.09.2014, 21:31

Но я указываю именно точку (getpoint), не выбираю блок. Если я правильно понимаю, я не могу тут использовать entsel ? Но точка лежит на объекте в составе блока всегда.

Дима_ · 04.09.2014, 22:41

Цитата:

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

Если я правильно понимаю, я не могу тут использовать entsel

Почему? - мне пока тяжело понять что Вы придумали.

skkkk · 04.09.2014, 23:04

Цитата:

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

(setq krdramka krd)

Сразу вопрос - так можно координаты присвоить новой переменной?

Можно.

Цитата:

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

Можно ли определить нужный блок вот так:
Код:
[Выделить все]

(setq ramka (vlax-ename->vla-object
(ssget '(krdramka) '((0 . "INSERT") (2 . "название_блока")))
))

Так мы получим не блок, а набор, и то, если исправим ошибки:

Код:

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

(setq ss (ssget krdramka '((0 . "INSERT") (2 . "название_блока")))

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

Код:

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

(setq ramka (ssname ss 0))

где 0 - порядковый номер примитива в наборе, начиная с нуля.
в итоге вся конструкция примет вид:

Код:

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

 (setq ramka 
		(vlax-ename->vla-object 
			(ssname 
				(ssget krdramka '((0 . "INSERT") (2 . "название_блока")))
				0
			)
		)
)

seregabs · 04.09.2014, 23:09

Лучше приложу начало лиспа незаконченного

Код:

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

(defun c:ins_ved ()
(setq krd (getpoint "\n Введите точку вставки:")) ; <- тут пользователь кликает на точку, лежащую на блоке "название"
(setq krdramka krd)                              ; <- работает ли так передача координат точки? 
(command "_insert" "Ведомость" krd 1 1 0 "16,9" "0,3" "0,3" "17,2") ; в указанную точку вставляется блок "Ведомость"

(vl-load-com)         
                                                                      
  (foreach Prop (vlax-Invoke (vlax-ename->vla-object (entlast)) 'GetDynamicBlockProperties) ; этими строками выбираю
    (if (= (vla-get-PropertyName Prop) "PosQuan") 				            ; нужную настройку свойства
      (vlax-put Prop 'Value "2 позиции")))					            ; дин. блока "Ведомость"
	  
(setq krd (LIST ( - ( CAR krd ) 1750) (- (CADR krd) 330) 0))                            ; вставляются еще n (тут два)
(command "_insert" "Str_Channel" krd 1 1 0 "12" "1,6" "16,7" "16,7" "С245" "27772-88")  ; других блоков с атрибутами
(setq krd (LIST ( CAR krd )  ( - ( CADR krd ) 100) 0))							    
(command "_insert" "Str_Plate" krd 1 1 0 "6" "110x45" "1" "0,2" "0,2" "С245" "27772-88")  

(setq ramka (vlax-ename->vla-object			     ; теперь мне нужно прописать блоку "название" определенное
  (ssget '(krdramka) '((0 . "INSERT") (2 . "название")))))   ; значение атрибута с тегом "KKS".
						             ; думал, что после этих строк можно будет работать с объектом
						             ; ramka - он же блок "название". и менять ему атрибут.
                                                             ; но, похоже, что через координаты точки не получается у меня блок определить
 )

skkkk успел ответить, пока я правил текст, поэтому на данный момент вопрос исчерпался. Спасибо! Буду доделывать теперь идею

ShaggyDoc · 05.09.2014, 07:13

Код:

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

 (setq krd (getpoint "\n Введите точку вставки:")) ; <- тут пользователь кликает на точку, лежащую на блоке "название"

Сразу источник ошибок:
1. Пользователь может кликнуть совсем не на точке, "лежащей на блоке", а промахнуться
2. Кликнет не на блоке "название", а на другом.
3. Пользователь может нажать Enter.
4. Пользователь может нажать ESC.

В любом случае все остальные действия будут бессмысленны. Правильно будет действовать только сам программист, да и то пока не забыл. А пользователь имеет право делать всё не так, и программист это должен учитывать. И писать код со всеми необходимыми проверками до "исполнения по существу".

Код:

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

 (command "_insert" "Ведомость" krd 1 1 0 "16,9" "0,3" "0,3" "17,2")

Будет включена какая-то объектная привязка и блок вставится совсем в другую точку. Да и масштабы вставки могут и будут разными - они должны вычисляться.

Далее смотреть код нет смысла.

Sirius2w · 05.09.2014, 16:46

Коллеги, кто поможет написать простенький ЛИСП?
Я начал прорабатывать блок-схему процесса но запутался и сам разобраться не могу.

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

Критерии обработки:
1) Блок должен содержать атрибут "марка" (причем у динамического блока имя одно и то же, а значение атрибута "марка" разное)
2) Блок не должен содержать атрибут "номер" со значением "б/п" (эти блоки нужно пропускать всегда)
3) Блокам с одинаковым значением атрибута "марка" должны быть присвоены одинаковые значения атрибута "номер"
4) Блоки, с пустым значением атрибута "номер" должны получить новое значение, при этом:
4.1 Изначально нумерация может быть хаотической, поэтому при первом запуске ЛИСП должен очистить все значения атрибутов "номер" не содержащих "б/п" на пустые значения.
4.2 После очистки ЛИСП присваивает в порядке возрастания всем блокам новые значения атрибутов "НОМЕР" в числовом формате 1.2.3.4.5.6.... и т.д.
с условием соблюдения предыдущих пунктов 1-2-3
5) При повторном запуске ЛИСП проверят какой список значений получился во всех значениях атрибутов "номер":
5.1. Если список содержит пропуски типа 1.2.3_._.5.6. и нет новых блоков с пустым значением атрибута "номер" - переписать поочередно максимальные значение на
пустующие.
5.2. Если имеются блоки с пустым значением атрибута "НОМЕР" (были добавлены новые блоки) - им присвоить очередные значения.

Пример файла во вложении.

Учитывая, что в лиспе пока вообще ни бум-бум... прошу объяснить с самого начала пошагово с реальными примерами.

Кулик Алексей aka kpblc · 05.09.2014, 17:04

Sirius2w, есть спец.раздел. Называется "Поиск исполнителей". У этой темы и у этого раздела задачи иные.

Sirius2w · 05.09.2014, 17:06

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

Кулик Алексей aka kpblc · 05.09.2014, 20:38

Sirius2w, ты же просишь не помочь тебе в разработке (объяснить скользкие моменты), а написать за тебя. Почему-то меня обуревают сомнения, что кто-то согласится...

gomer · 05.09.2014, 21:28

Я бы взялся, но

Цитата:

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

Почему-то меня обуревают сомнения

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

Sirius2w · 07.09.2014, 13:57

Цитата:

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

Sirius2w, ты же просишь не помочь тебе в разработке (объяснить скользкие моменты), а написать за тебя. Почему-то меня обуревают сомнения, что кто-то согласится...

Я исправил пост. Если честно - очень хочу научиться, но вообще нет времени ...
Прогресс конечно есть - не совсем ноль, начал к примеру с этого:

(defun c:ATConsecutive_numbering ()
а как дальше - вообще не понятно.

gomer · 07.09.2014, 14:10

Sirius2w, у тебя в "коде" не хватает завершающей скобки

Код:

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

 (defun c:ATConsecutiveNumbering ( / )
  ;; твой код...
)

Sirius2w · 07.09.2014, 15:12

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

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

	Реклама i