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

_____________________________________________________________________________________________________________

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

МишаИнженер · 07.12.2022, 18:12

Вот в таком виде получается доступ к командам если искомая штриховка находится в списке штриховок чертежа:

Код:

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

 
(defun C:SetProp ()
	(while (setq el (car (entsel "\n Выбери объект:")))
	;entsel выдает имя объекта и все остальное, car - Извлекает первый элемент из списка: имя объекта
	;команды которые должны выполняться в цикле пока не будет пустой ввод
	  (setq dan (entget el));получает список с характеристиками примитива
	  (setq name0 (assoc 0 dan)) ;получаем имя объекта
	  (setq name (cdr name0))
	  (princ (strcat " " name))
;;;	  (alert (strcat "Был выбран " name))
	  (princ (strcat (chr 10) "========================================================="))
	  (princ (strcat (chr 10) "Был выбран " name))
	  (setq cLayer0 (assoc 8 dan)) ;получаем имя объекта
	  (setq cLayer (cdr cLayer0))
	  (setq cLWeight0 (assoc 370 dan)) ;получаем текущий вес линии
	  (setq cLWeight (cdr cLWeight0))
	  (setq cLType0 (assoc 6 dan)) ;получаем текущий тип линии
	  (setq cLType (cdr cLType0))  
	  (setq cLTypeScale0 (assoc 48 dan)) ;получаем текущий масштаб типа линии
	  (setq cLTypeScale (cdr cLTypeScale0))
	  (setq cColor0 (assoc 62 dan)) ;получаем текущий цвет
	  (setq cColor (cdr cColor0))
	  (setq cThick0 (assoc 39 dan)) ;получаем текующую толщину
	  (setq cThick (cdr cThick0))
	  
	;Назначим текущим слой выбранного объекта (setvar "clayer" <имя слоя>)
	  (setvar "clayer" cLayer)
	  (princ (strcat (chr 10) "Был назначен текущий слой " (chr 34) cLayer (chr 34)))
	;Назначим текущий вес линий
	  (cond ((eq cLWeight nil)
			(setvar "CELWEIGHT" -1)
			(princ (strcat (chr 10) "Был назначен текущий вес линий " (chr 34) "ПоСлою" (chr 34)))
			)
		((eq cLWeight -2)
			(setvar "CELWEIGHT" -2)
			(princ (strcat (chr 10) "Был назначен текущий вес линий " (chr 34) "ПоБлоку" (chr 34)))
			)
		((eq cLWeight -3)
			(setvar "CELWEIGHT" -3)
			(princ (strcat (chr 10) "Был назначен текущий вес линий " (chr 34) "ПоУмолчанию" (chr 34)))
			)
		(t 
			(setvar "CELWEIGHT" cLWeight)
			(princ (strcat (chr 10) "Был назначен текущий вес линий " (chr 34) (rtos (/ cLWeight 100.0)) (chr 34)))
		)
	   )
	;Назначим текущий тип линии
	  (cond ((eq cLType nil)
			(setvar "CELTYPE" "ByLayer")
			(princ (strcat (chr 10) "Был назначен текущий тип линий " (chr 34) "ПоСлою" (chr 34)))
			)
		(t 
			(setvar "CELTYPE" cLType)
			(princ (strcat (chr 10) "Был назначен текущий тип линий " (chr 34) cLType (chr 34)))
		)
	   )
	;Назначим текущий масштаб типа линии
	  (cond ((eq cLTypeScale nil)
			(setvar "CELTSCALE" 1)
			(princ (strcat (chr 10) "Был назначен текущий масштаб типа линий " (chr 34) "1" (chr 34)))
			)
		(t 
			(setvar "CELTSCALE" cLTypeScale)
			(princ (strcat (chr 10) "Был назначен текущий масштаб типа линий " (chr 34) (rtos cLTypeScale) (chr 34)))
		)
	   )
	;Назначим ткущий цвет чертежа
	  (cond ((eq cColor nil)
			(setvar "CECOLOR" "ByLayer")
			(princ (strcat (chr 10) "Был назначен текущий цвет " (chr 34) "ПоСлою" (chr 34)))
			)
		((eq cColor 0)
			(setvar "CECOLOR" "ByBlock")
			(princ (strcat (chr 10) "Был назначен текущий цвет " (chr 34) "ПоБлоку" (chr 34)))
			)
		(t 
			(setvar "CECOLOR" (rtos cColor))
			(princ (strcat (chr 10) "Был назначен текущий цвет " (chr 34) (rtos cColor) (chr 34)))
		)
	   )
	;Назначаем текущую толщину
	  (cond ((eq cThick nil)
			(setvar "THICKNESS" 0)
			(princ (strcat (chr 10) "Была назначена текущая толщина " (chr 34) "0" (chr 34)))
			)
		(t 
			(setvar "THICKNESS" cThick)
			(princ (strcat (chr 10) "Была назначена текущая толщина " (chr 34) (rtos cThick) (chr 34)))
		)
	   )
	;Назначим особые свойства для сложных объектов
	  (setq TypeObj (strcase name)) 
	  (cond 
		((eq TypeObj "ACAD_TABLE");Назначим текущий стиль таблиц
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(setvar "CTABLESTYLE" StyleName)
			(princ (strcat (chr 10) "Был назначен текущий стиль таблиц " (chr 34) StyleName (chr 34)))
		)
		((eq TypeObj "MTEXT");Назначим текущий стиль текста
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(setvar "TEXTSTYLE" StyleName)
			(princ (strcat (chr 10) "Был назначен текущий стиль текста " (chr 34) StyleName (chr 34)))
		)
		((eq TypeObj "MULTILEADER");Назначим текущий стиль мультивыносок
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(setvar "CMLEADERSTYLE" StyleName)
			(princ (strcat (chr 10) "Был назначен текущий стиль мультивыносок " (chr 34) StyleName (chr 34)))
		)
		((eq TypeObj "MLINE");Назначим текущий стиль мультилинии
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(setvar "CMLSTYLE" StyleName);CMLSCALE CMLJUST
			(princ (strcat (chr 10) "Был назначен текущий стиль мультилиний " (chr 34) StyleName (chr 34)))
		)
		((eq TypeObj "DIMENSION");Назначим текущий стиль размеров
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(command "_-dimstyle" "_r" StyleName)
			(princ (strcat (chr 10) "Был назначен текущий стиль размеров " (chr 34) StyleName (chr 34)))
		)
		((eq TypeObj "HATCH");Назначим текущий стиль штриховки
			(setq StyleName (cdr (assoc 2 dan)))
		 	(setq HatchCol (FHS))
		 	(if (member StyleName HatchCol)
				(progn
					(setvar "HPNAME" StyleName)
					(princ (strcat (chr 10) "Был назначен текущий стиль штриховки " (chr 34) StyleName (chr 34)))
				)
			  	(princ (strcat (chr 10) "Штриховка " (chr 34) StyleName (chr 34) " ненайдена среди штриховок АвтоКада"))
			)
		)
	  )
	)
)

(defun FHS ();FindHatchStyle Поиск Стиля Штриховки
;Собирает имена всех шаблонов штриховки, используемых в текущем чертеже, включая те, которые используются только внутри блоков
  (vlax-for block (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
    (vlax-for obj block
      (if (and
		  (eq (vla-get-objectname obj) "AcDbHatch")
		  (not (member (setq h (vla-get-PatternName obj)) l))
	   )
	   (setq l (cons h l))
      );_end if
    )
  )
  (acad_strlsort l)
)

Однако если такой штриховки нет среди штриховок АвтоКада, то системная переменная не получает новое значение и функция генерирует ошибку и вылетает.
Может быть надо использовать функцию обнаружения ошибки чтобы обработать эту ошибку?
Или надо создавать вместо списка штриховок чертежа - список штриховок АвтоКада. Наверное создание такого списка может потребовать несколько секунд и будет казаться долгим. Поэтому проще отловить факт появления ошибки и оценить это как отсутствие штриховки среди доступных штриховок АвтоКада.

Кулик Алексей aka kpblc · 07.12.2022, 19:53

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

МишаИнженер · 11.12.2022, 12:25

Цитата:

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

'vla-object

Цитата:

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

******dict

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

Кулик Алексей aka kpblc · 11.12.2022, 12:38

А почитать, подумать, проанализировать - не?

Код:

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

Dim aValue As Integer
Dim bValue As Integer
aValue =
  bValue

Последнюю строку тоже снесешь?

Konstr_pgs · 13.12.2022, 11:36

Нужна помощь в корректировке лиспа Сумматор текста (автор Владимир Громов, корр.ZZZ, Евгений Елпанов, Вадим).
1. В лиспе есть "." и ",", но нет возможности выбрать(собственно выбор не нужен, нужна точка),
сумма вставляется с ",".
Если просто удалить "," пишет в КС: ; ошибка: слишком мало аргументов. Как можно вставку суммы
производить с разделителем "."?
2. А ещё выскакивает табличка
Сообщение AutoCad Сумма=2,18
Укажите точку вставки
Надо жать на ОК, потом указывать точку вставки, ненужные движения.
Можно убрать эту таблицу, просто указывать точку вставки суммы в чертеж.
3. Добавить возможность выбора высоты текста, или лучше по умолчанию 250. Такая странность, если
установить текущим стиль текста с заданной высотой 250, текст вставляет "0" да ещё
с поворотом 3 градуса, при этом, в окне показывается правильная сумма... Корректно работает только с высотой текста 2.5.
Подскажите, пожалуйста, в чём затык.

Код:

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

 (defun c:z-calc-text-value (/ value ent obj ss)
  (vl-load-com)
  (princ
    "\nВыберите текстовые объекты среди которых будет произведененна калькуляция"
    ) ;_ princ
  (setq ss (ssget '((0 . "TEXT,MTEXT"))))
  (if (not ss)
    (princ "Не выбраны объекты")
    (progn
      (setq
  value (rtos
    (apply
      (function +)
      (mapcar
        (function
          (lambda (a)
      (atof
        (vl-string-trim
          "%Uu {\\Ll}"
          (vl-string-subst
            "."
            ","
            (cdr (assoc 1 (entget a)))
            ) ;_ vl-string-subst
          ) ;_ vl-string-trim
        ) ;_ atof
      ) ;_ lambda
          ) ;_ function
        (vl-remove-if
          (function listp)
          (mapcar (function cadr)
            (ssnamex ss)
            ) ;_ mapcar
          ) ;_ vl-remove-if
        ) ;_ mapcar
      ) ;_ apply
    ) ;_ rtos
  ) ;_ setq
      (if (vl-string-position (ascii ".") value)
  (setq value (vl-string-right-trim ".0" value))
  ) ;_ if
      (setq value (vl-string-subst "," "." value))
      (princ (strcat "\n Сумма = " value))
      (alert (strcat "Сумма = " value "\nУкажите точку вставки "))
      (setvar "ERRNO" 0)
      (if (and ent
         (vlax-property-available-p
     (setq obj (vlax-ename->vla-object ent))
     'TextString
     ) ;_ vlax-property-available-p
         ) ;_ and
  (progn
    (vlax-put-property obj 'TextString value)
    (vlax-release-object obj)
    ) ;_ progn
  ) ;_ if
      ) ;_ progn
    ) ;_ if
  (setq pt2 (getpoint))
  (setq r (* (getvar "DIMSCALE") (getvar "DIMTXT")))
   (command "_text" pt2 r 0 value)
  (princ)
  ) ;_ defun

skkkk · 13.12.2022, 15:50

Цитата:

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

1. В лиспе есть "." и ",", но нет возможности выбрать(собственно выбор не нужен, нужна точка),
сумма вставляется с ",".

Убрать в коде строчку 42

Цитата:

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

2. А ещё выскакивает табличка
Сообщение AutoCad Сумма=2,18
Укажите точку вставки
Надо жать на ОК, потом указывать точку вставки, ненужные движения.
Можно убрать эту таблицу, просто указывать точку вставки суммы в чертеж.

Убрать строчку 44.

Цитата:

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

3. Добавить возможность выбора высоты текста, или лучше по умолчанию 250.

После строки 53 добавить строку:

Код:

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

(vlax-put-property obj 'Height 250)

Konstr_pgs · 13.12.2022, 16:19

skkkk, спасибо большое, буду пробовать...
Всё работает, как хотелось! Только сумму меньше нуля выводит в виде .27 (а не 0.27) Это можно изменить?
Вот подкорректированный код

Код:

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

 (defun c:z-calc-text-value (/ value ent obj ss)
 (vl-load-com)
 (princ
   "\nВыберите текстовые объекты среди которых будет произведененна калькуляция"
   ) ;_ princ
 (setq ss (ssget '((0 . "TEXT,MTEXT"))))
 (if (not ss)
   (princ "Не выбраны объекты")
   (progn
     (setq
 value (rtos
   (apply
     (function +)
     (mapcar
       (function
         (lambda (a)
     (atof
       (vl-string-trim
         "%Uu {\\Ll}"
         (vl-string-subst
           "."
           ","
           (cdr (assoc 1 (entget a)))
           ) ;_ vl-string-subst
         ) ;_ vl-string-trim
       ) ;_ atof
     ) ;_ lambda
         ) ;_ function
       (vl-remove-if
         (function listp)
         (mapcar (function cadr)
           (ssnamex ss)
           ) ;_ mapcar
         ) ;_ vl-remove-if
       ) ;_ mapcar
     ) ;_ apply
   ) ;_ rtos
 ) ;_ setq
     (if (vl-string-position (ascii ".") value)
 (setq value (vl-string-right-trim ".0" value))
 ) ;_ if
     (princ (strcat "\n Сумма = " value))
     (setvar "ERRNO" 0)
     (if (and ent
        (vlax-property-available-p
    (setq obj (vlax-ename->vla-object ent))
    'TextString
    ) ;_ vlax-property-available-p
        ) ;_ and
 (progn
   (vlax-put-property obj 'TextString value)
  (vlax-put-property obj 'Height 250)
   (vlax-release-object obj)
   ) ;_ progn
 ) ;_ if
     ) ;_ progn
   ) ;_ if
 (setq pt2 (getpoint))
 (setq r (* (getvar "DIMSCALE") (getvar "DIMTXT")))
  (command "_text" pt2 r 0 value)
 (princ)
 ) ;_ defun

Кулик Алексей aka kpblc · 13.12.2022, 16:37

Цитата:

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

Это можно изменить?

Можно: https://autolisp.ru/2021/05/19/chto-...-te-rezultaty/

Konstr_pgs · 13.12.2022, 16:50

Спасибо, Алексей. DIMZIN в "8" и отображается с нулем 0.25. А была DIMZIN 13 (AutoCad 2015rus), в справке нет такой цифры...

===AAA=== · 14.12.2022, 07:45

DIMZIN - битовая величина

13 = 1+4+8

Кулик Алексей aka kpblc · 14.12.2022, 07:51

Цитата:

Сообщение от ===AAA===

DIMZIN - битовая величина

13 = 1+4+8

Сомневаюсь. Значение 3 как толковать? А 12? Как 12 или как 4+8? )))

===AAA=== · 14.12.2022, 08:31

Если верить справке (в которой - надо отметить - нет упоминания о "битовости" этой переменной), то:

4
Подавляет ведущие нули в десятичных размерах (например, 0,5000 записывается как ,5000)
8
Подавляет замыкающие нули в десятичных размерах (например, 12,5000 записывается как 12,5)
12
Подавляет и ведущие, и замыкающие нули (например, 0,5000 записывается как ,5)

Тогда 12=8+4

Вот с "тройкой", действительно, кривовато как-то.

Экспериментировать надо. Но для футов и дюймов не слишком оно актуально...

Но - опять же:

Команда: DIMZIN
Новое значение DIMZIN <13>: 18
Требуется целое значение от 0 до 15.

Что это, как не "битовость"?

Кулик Алексей aka kpblc · 14.12.2022, 08:47

Уговорил, чертяка языкатый

koMon · 14.12.2022, 09:23

Konstr_pgs · 14.12.2022, 15:23

Тема решилась см. #4337

Konstr_pgs · 24.12.2022, 10:43

Если в чертеже просуммировать 3 текста, то получается такой код поля

Код:

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

  %<\AcExpr (%<\_FldPtr 891083120>%+%<\_FldPtr 891087632>%+%<\_FldPtr 891087152>%) \f "%lu2%pr2">%

Подскажите, пожалуйста, как оформить код на лиспе для поля суммы множества текстов

Код:

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

 "%<\\AcObjProp Object(%<\\_ObjId "
	          (LM:objectid (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
	                              ">%).TextString>%" " + " lst

Konstr_pgs · 11.01.2023, 15:02

Вопрос с полями суммы решился в теме "Поле суммы нескольких текстов". Спасибо gumel & Lee Mac!

Sege · 06.02.2023, 09:21

Коллеги! Возможно торможу, но как с помощью ssget выбрать определенные объекты (например TEXT,MTEXT), которые находятся внутри заданной окружности.
Пока вижу только такой метод:
(ssget "_W" '(x1 y1) '(x2 y2))
где x1 y1, x2 y2 - координаты рамки, описывающую окружность (т.е. надо вычислить две точки рамки-квадрата, с учетом координаты центра круга и радиуса)
Или можно проще?

Сергей812 · 06.02.2023, 10:30

все варианты ssget от Lee Mac. Есть еще ключ _WP - для непрямоугольных окон выбора.

Кулик Алексей aka kpblc · 06.02.2023, 10:33

Чисто теоретически можно высчитать несколько десятков точек (так сказать, аппроксимировать окружность полигоном) и выбирать уже не через _W, а через _CP (кажется, так)

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