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

_____________________________________________________________________________________________________________

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

LcH · 01.12.2016, 15:56

Добрый день!

Спасибо, что откликнулись, мне хотелось посоветоваться.
Явное указание имени файла шаблона (полного пути к файлу или без него) не подходит для моего случая, т.к. файлов dwt – несколько, в данном случае эти dwt содержат шаблоны оформления листов.
Параметры печати листов в одном dwt настроены на драйвер DWF6 ePlot.pc3, в другом листы тех же форматов и допустимыми формами основных надписей (согласно ГОСТ и СТО предприятия) настроены на печать через DWGToPDF.pc3. Третий файл dwt – те же листы, но настройка печати через doPDF. Есть еще dwt c динамическим блоком рамки и штампа и различными наборами для переопределения параметров печати. Хотелось, чтобы был выбор в диалоге, диалог сразу выходил на определенную папку. Хотя это, конечно, не большая проблема, папка на сервере всем известна, к тому же в диалоге "Выбор шаблона из файла" путь можно добавить в "Избранное". Просто хотят кнопку на ленте, нажав на которую, сразу получить лист, с требуемыми параметрами.
Интересно поэкспериментировать с заданием пути в реестре, но, наверно, значение "InitialDirectory" будет меняться только после закрытия и повторного запуска Автокада. Все равно, попробую.
! Большое спасибо за ссылку на "Steal from Drawing".
Как раз с этой программой попробую сейчас поработать.

Maksim7enov · 06.12.2016, 13:14

Здравствуйте! Совсем не понимаю в лисп, но хотел бы спросить возможно ли создать по данной методике лисп для построения аксонометрических схем? Метод не знаю кому принадлежит но ОГРОМНОЕ спасибо тому кто это придумал!!
1.Повернуть систему на 315 гр.;
2.Сделать блок, либо скопировать и вставить как блок;
Вызвать, если нет панели «Свойств». Вызов панели Ctrl +1.
3.Выделить блок;
4.В панели свойств в пункте «Геометрия (Geometry):
Строка масштаб Y (Scale Y) задать 0,4142
5.Пункт «Прочее» (Misc) строка Поворот (Rotation) 22,5
6.Увеличить (Scale) весь блок в 1,306569 раз.

Кулик Алексей aka kpblc · 06.12.2016, 13:52

Maksim7enov, наверное, возможно. Попробуй.

skkkk · 06.12.2016, 15:15

Maksim7enov, а имеющийся на форуме лисп Gakson не подойдет?

Maksim7enov · 06.12.2016, 15:19

Спасибо сейчас посмотрю. Я макрос сделал но там с масштабом проблема сейчас ее решаю. Проблема макроса в том что надо еще 2 раза выбирать объект я не понимаю как автоматически сделать выбор нужных объектов. Не получается масштаб к нему приделать. Макрос выкладываю может кому и понадобится

Код:

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

^C^C_rotate;\315;_block;1234;@;\\;__insert;1234;@;;0.4142;22.5;_scale;\@;\1.306569;

skkkk · 06.12.2016, 15:29

Вообще интересно стало, что это за схема манипуляций с блоком такая. Реализовать подобный алгоритм довольно просто, однако я решил проверить все по пунктам - результат мне не понятен. То ли я неправильно делал, то ли у нас с автором этой методики разные понимания об аксонометрии. Результаты изобразил во вложении. Может, стоит уточнить, также об аксонометрии ЧЕГО идет речь?

Maksim7enov · 06.12.2016, 15:35

У меня все получается. Беру объекты, поворачиваю на 315, потом создаю из них блок и меняю масштаб по Y и поворот. Масштабирую и все. Просто хотелось самому создать и все. Буду благодарен если подскажите в моем макросе возможно сделать так чтобы при масштабировании не выделять объекты а сослаться на ранее сделанный блок? т.е убрать лишний раз движение рамой выделения?

----- добавлено через ~10 мин. -----
Макрос доделал. Если кто будет пользоваться (хотя сомневаюсь) то вот:

Код:

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

^C^C_rotate;\315;_block;1234;@;\\;__insert;1234;@;;0.4142;22.5;_scale;\;@;1.306569;

Red Nova · 08.12.2016, 02:58

Ку!
Почему vla-move у меня не работает? Или как иначе передвинуть объекты?
Файл в аттаче.

Код:

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

 (defun c:BMP_CSStretchstart2 ( / adoc blkselection vlablkselection hiddenlength pt1 pt2 dxpt ucschanged firstblockmarker *error*)

  (defun *error* ( msg )
 	(if ucschanged (command-s "_.ucs" "_prev"))        
        (princ  "\nError: Function cancelled")
        (princ)
    )

  (vl-load-com)

  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object)))) ;_ end of vla-startundomark

  (setq blkselection (ssget '((0 . "INSERT")(66 . 1))))
  (setq vlablkselection (LM:ss->vla blkselection))

  (foreach n vlablkselection
    (if
      (LM:getdynpropvalue n "Hidden Length")
      (if
	(princ firstblockmarker)
	(progn
	  (setq hiddenlength (LM:getdynpropvalue n "Hidden Length"))
	  (setq hiddedlength (+ hiddenlength dxpt))
	  (LM:setdynpropvalue n "Hidden Length" hiddedlength)
	  (vla-move n '(0. 0. 0.) (cons dxpt '(0. 0.)))
	  )
	(progn
	  (setq firstblockmarker t)
	  (ucsobj (car (LM:ss->vla blkselection))); set new UCS
	  (setq ucschanged T) ; marker for *error* to reset UCS if routine doesn't get to it
	  (setq pt1 (getpoint "Pick Start Point:"))
	  (setq pt2 (getpoint "Pick End Point:"))
	  (setq dxpt (- (car pt2) (car pt1))); delta x between pt1 and pt2
	  (setq hiddenlength (LM:getdynpropvalue n "Hidden Length"))
	  (setq hiddedlength (+ hiddenlength dxpt))
	  (LM:setdynpropvalue n "Hidden Length" hiddedlength)
	  (vla-move n '(0. 0. 0.) (cons dxpt '(0. 0.)))
	  )
	)
      )
    )

  (command "ucs" "P" ""); return previous UCS
  (setq ucschanged nil)

  (vla-endundomark adoc) ;;; undomark bottom mark
  )


;;;

;; Get Dynamic Block Property Value  -  Lee Mac
;; Returns the value of a Dynamic Block property (if present)
;; blk - [vla] VLA Dynamic Block Reference object
;; prp - [str] Dynamic Block property name (case-insensitive)

(defun LM:getdynpropvalue ( blk prp )
    (setq prp (strcase prp))
    (vl-some (function (lambda ( x ) (if (= prp (strcase (vla-get-propertyname x))) (vlax-get x 'value))))
        (vlax-invoke blk 'getdynamicblockproperties)
    )
)

;; Set Dynamic Block Property Value  -  Lee Mac
;; Modifies the value of a Dynamic Block property (if present)
;; blk - [vla] VLA Dynamic Block Reference object
;; prp - [str] Dynamic Block property name (case-insensitive)
;; val - [any] New value for property
;; Returns: [any] New value if successful, else nil

(defun LM:setdynpropvalue ( blk prp val )
    (setq prp (strcase prp))
    (vl-some
       '(lambda ( x )
            (if (= prp (strcase (vla-get-propertyname x)))
                (progn
                    (vla-put-value x (vlax-make-variant val (vlax-variant-type (vla-get-value x))))
                    (cond (val) (t))
                )
            )
        )
        (vlax-invoke blk 'getdynamicblockproperties)
    )
)


;;------------=={ SelectionSet -> VLA Objects }==-------------;;
;;                                                            ;;
;;  Converts a SelectionSet to a list of VLA Objects          ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  ss - Valid SelectionSet (Pickset)                         ;;
;;------------------------------------------------------------;;
;;  Returns:  List of VLA Objects, else nil                   ;;
;;------------------------------------------------------------;;

(defun LM:ss->vla ( ss / i l )
    (if ss
        (repeat (setq i (sslength ss))
            (setq l (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) l))
        )
    )
)

;align the ucs according to the selected object
(defun ucsobj ( obj / insertion rotation adoc regUCS)
;(setq obj (vlax-ename->vla-object (car (entsel))))
(setq insertion (vlax-get obj 'InsertionPoint)
      rotation (vlax-get obj 'Rotation)
      adoc (vla-get-activedocument (vlax-get-acad-object))
      regUCS (vla-add
	       (vla-get-usercoordinateSystems adoc)
               (vlax-3D-point '(0 0 0))
               (vlax-3D-point (list (cos rotation) (sin rotation) 0))
               (vlax-3d-point (list (* -1 (sin rotation)) (cos rotation) 0))
               "ucs_obj")
      )
  (vla-put-origin regUCS (vlax-3d-point insertion 0 1))
  (vla-put-activeUCS adoc regUCS)
  )

Psyakrev · 08.12.2016, 04:46

Red Nova,
Координаты начальной и конечной точки должны быть вариантами. Создавать можно через vlax-3D-point.

Код:

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

 (setq point1 (vlax-3D-point 0 0 0))
(setq point2 (vlax-3D-point x y z))
(vla-move object point1 point2)

Red Nova · 08.12.2016, 06:17

Спасибо. С этой частью ясно. Возникла другая загвоздка. До того лисп выглядел несколько иначе и я перемещал блоки командными методами. То есть как-то так:
(command "_.move" blkselection "" "_non" '(0. 0. 0.) "_non" (cons dxpt '(0. 0.)))
При этом я менял координатную систему по текущему блоку, и тогда, все вычисления и перемещения проводились просто по оси Х.
Но при применении vla-move перемещение происходит в глобальной системе координат.
Есть вариант заставить работать vla-move в пользовательской системе координат?
Текущий вариант кода. Пример с пояснением в аттаче.

Код:

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

 
(defun c:BMP_CSStretchstart2 ( / adoc blkselection vlablkselection hiddenlength pt1 pt2 dxpt ucschanged firstblockmarker *error*)

  (defun *error* ( msg )
 	(if ucschanged (command-s "_.ucs" "_prev"))        
        (princ  "\nError: Function cancelled")
        (princ)
    )

  (vl-load-com)

  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object)))) ;_ end of vla-startundomark

  (setq blkselection (ssget '((0 . "INSERT")(66 . 1))))
  (setq vlablkselection (LM:ss->vla blkselection))

  (foreach n vlablkselection
    (if
      (LM:getdynpropvalue n "Hidden Length")
      (if
	(princ firstblockmarker)
	(progn
	  (setq hiddenlength (LM:getdynpropvalue n "Hidden Length"))
	  (setq hiddedlength (- hiddenlength dxpt))
	  (LM:setdynpropvalue n "Hidden Length" hiddedlength)
	  (vla-move n (vlax-3D-point'(0. 0. 0.)) (vlax-3D-point (cons dxpt '(0. 0.))))
	  )
	(progn
	  (setq firstblockmarker t)
	  (ucsobj n); set new UCS
	  (setq ucschanged T) ; marker for *error* to reset UCS if routine doesn't get to it
	  (setq pt1 (getpoint "Pick Start Point:"))
	  (setq pt2 (getpoint "Pick End Point:"))
	  (setq dxpt (- (car pt2) (car pt1))); delta x between pt1 and pt2
	  (setq hiddenlength (LM:getdynpropvalue n "Hidden Length"))
	  (setq hiddedlength (- hiddenlength dxpt))
	  (LM:setdynpropvalue n "Hidden Length" hiddedlength)
	  (vla-move n (vlax-3D-point'(0. 0. 0.)) (vlax-3D-point (cons dxpt '(0. 0.))))
	  )
	)
      )
    )

  (command "ucs" "P" ""); return previous UCS
  (setq ucschanged nil)

  (vla-endundomark adoc) ;;; undomark bottom mark
  )

;;;

;; Get Dynamic Block Property Value  -  Lee Mac
;; Returns the value of a Dynamic Block property (if present)
;; blk - [vla] VLA Dynamic Block Reference object
;; prp - [str] Dynamic Block property name (case-insensitive)

(defun LM:getdynpropvalue ( blk prp )
    (setq prp (strcase prp))
    (vl-some (function (lambda ( x ) (if (= prp (strcase (vla-get-propertyname x))) (vlax-get x 'value))))
        (vlax-invoke blk 'getdynamicblockproperties)
    )
)

;; Set Dynamic Block Property Value  -  Lee Mac
;; Modifies the value of a Dynamic Block property (if present)
;; blk - [vla] VLA Dynamic Block Reference object
;; prp - [str] Dynamic Block property name (case-insensitive)
;; val - [any] New value for property
;; Returns: [any] New value if successful, else nil

(defun LM:setdynpropvalue ( blk prp val )
    (setq prp (strcase prp))
    (vl-some
       '(lambda ( x )
            (if (= prp (strcase (vla-get-propertyname x)))
                (progn
                    (vla-put-value x (vlax-make-variant val (vlax-variant-type (vla-get-value x))))
                    (cond (val) (t))
                )
            )
        )
        (vlax-invoke blk 'getdynamicblockproperties)
    )
)


;;------------=={ SelectionSet -> VLA Objects }==-------------;;
;;                                                            ;;
;;  Converts a SelectionSet to a list of VLA Objects          ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  ss - Valid SelectionSet (Pickset)                         ;;
;;------------------------------------------------------------;;
;;  Returns:  List of VLA Objects, else nil                   ;;
;;------------------------------------------------------------;;

(defun LM:ss->vla ( ss / i l )
    (if ss
        (repeat (setq i (sslength ss))
            (setq l (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) l))
        )
    )
)

;align the ucs according to the selected object
(defun ucsobj ( obj / insertion rotation adoc regUCS)
;(setq obj (vlax-ename->vla-object (car (entsel))))
(setq insertion (vlax-get obj 'InsertionPoint)
      rotation (vlax-get obj 'Rotation)
      adoc (vla-get-activedocument (vlax-get-acad-object))
      regUCS (vla-add
	       (vla-get-usercoordinateSystems adoc)
               (vlax-3D-point '(0 0 0))
               (vlax-3D-point (list (cos rotation) (sin rotation) 0))
               (vlax-3d-point (list (* -1 (sin rotation)) (cos rotation) 0))
               "ucs_obj")
      )
  (vla-put-origin regUCS (vlax-3d-point insertion 0 1))
  (vla-put-activeUCS adoc regUCS)
  )

Psyakrev · 08.12.2016, 08:34

Нужно переводить одну систему координат в другу функцией trans.

Browning Zed · 08.12.2016, 12:00

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

Код:

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

 (defun C:LayerOnOff ( / layers layer ss )

  (setq layers '("L1" "L2" "L3" "L4"))

  (initget 1 "L1 L2 L3 L4")
  (setq layer (getkword "\nChoose Target Layer [L1/L2/L3/L4] : "))

  (setq layer (car (member layer layers)))

    (progn
       (command "_-LAYER" "_ON" layer "")
       (princ " Слой ") (Princ layer) (princ " включен.")
    ) ; progn

    (progn
       (if (or (= (getvar "CLAYER") L1)
                 (= (getvar "CLAYER") L2)
                 (= (getvar "CLAYER") L3)
                 (= (getvar "CLAYER") L4))
             (command "_-LAYER" "_off" layer "_y" "")
             (command "_-LAYER" "_off" layer "")
       ) ; if
    (princ " Слой ") (Princ layer) (princ " выключен.")
    ) ; progn
) ; if
(princ)
)

Кулик Алексей aka kpblc · 08.12.2016, 12:39

У тебя полная путаница с if и progn

Red Nova · 08.12.2016, 15:46

Psyakrev, Спасибо, попробую

VVA · 08.12.2016, 16:29

Browning Zed, А как ты узнаешь, отключен слой или включен?
Пробуй так

Код:

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

 (defun C:LayerOnOff ( / layers layer ss )
  (initget 1 "L1 L2 L3 L4")
  (setq layer (getkword "\nChoose Target Layer [L1/L2/L3/L4] : "))
   (mip-layer-onoff (list layer) 2 nil)
(princ)
)

(defun mip-layer-onoff ( laylist what mask  / lay lays)
  ;;; (mip-layer-onoff '("Сло") 0 t)
  ;;; (mip-layer-onoff '("Слой1") 0 nil)
  ;;; laylist - список слоев (вернее масок) '("Слой" "АД")
  ;;; what - 0 - откл 1 - вкл 2 - инверсия
  ;;; mask - t - маска nil - полное совпадение
  (setq lays (mapcar 'strcase (TABLELIST "layer")))
  (foreach item (mapcar 'strcase  laylist)
    (foreach item1 (vl-remove-if-not '(lambda(x)(wcmatch (strcase x)(strcat (if mask "*" "")(strcase item)(if mask "*" "")))) lays)
      (vla-put-LayerOn (setq lay (vla-item (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) item1))
        (cond ((= what 0) :vlax-false)
              ((= what 2) (if (eq (vla-get-layeron lay) :vlax-false) :vlax-true :vlax-false))
              (t :vlax-true) ;_what=1
              )
        )
      )
  )
  )

Browning Zed · 08.12.2016, 16:52

Цитата:

А как ты узнаешь, отключен слой или включен?

Я имею весьма туманное представление о языке lisp. Просто попытался скомбинировать две программки, найденные в сети, надеясь на русское "авось и прокатит". Не прокатило.

Цитата:

Пробуй так

К сожалению, тоже не работает. На слое L1 находятся объекты. Запускаю программу. Запрос: "Choose Target Layer", выбираю L1 - слой не включается и не отключается.

Кулик Алексей aka kpblc · 08.12.2016, 17:11

Код:

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

 (vl-load-com)

(defun c:layeronoff (/ adoc layers layer ss)
  (if (= (type
           (setq layer (vl-catch-all-apply
                         (function
                           (lambda () (initget 1 "L1 L2 L3 L4") (getkword "\nChoose Target Layer [L1/L2/L3/L4] <Cancel> : "))
                           ) ;_ end of function
                         ) ;_ end of vl-catch-all-apply
                 ) ;_ end of setq
           ) ;_ end of type
         'str
         ) ;_ end of =
    (progn (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
           (if (= (type
                    (setq layer (vl-catch-all-apply (function (lambda () (vla-item (vla-get-layers adoc) layer)))))
                    ) ;_ end of type
                  'vla-object
                  ) ;_ end of =
             (vla-put-layeron layer
                              (if (equal (vla-get-layeron layer) :vlax-true)
                                :vlax-false
                                :vlax-true
                                ) ;_ end of if
                              ) ;_ end of vla-put-layeron
             ) ;_ end of if
           (vla-endundomark adoc)
           ) ;_ end of progn
    ) ;_ end of if
  (princ)
  ) ;_ end of defun

Browning Zed · 08.12.2016, 17:47

Кулик Алексей aka kpblc, спасибо, друг. Выручил! Не подскажешь ещё вариант данного лиспа кода слой надо не включить/выключить, а заморозить/разморозить?

Кулик Алексей aka kpblc · 08.12.2016, 20:26

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

Inferi · 14.12.2016, 17:27

Доброго времени суток, подскажите возможно ли обратиться к командной строке windows из под лиспа напрямую? На ум приходит запускать батник из лиспа, результат сохранять скажем в блокнот, а оттуда считывать данные. Всего то нужна одна строчка "WHOAMI /FQDN"

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

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