[Red Nova]

Со школы не ладится у меня с программированием. Все предметы щелкал, а на экзамене по информатике (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

_____________________________________________________________________________________________________________

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

[RNB]

Товарисчи, подскажите решение в лиспе.
http://forum.dwg.ru/showpost.php?p=1...&postcount=733
Интересует циклическое повторение ввода данных вручную, до нажатия пользователем Enter или Esc

[Кулик Алексей aka kpblc]

RNB, тебя научить надо? Тогда добро пожаловать (в качестве начального варианта): http://autolisp.ru/2009/09/13/error-catch/ + http://autolisp.ru/2012/03/16/user-request/

[Vladimir_Sergeevich]

Алексей, еще вопрос про DXF 100: есть ли где то инфа про то, где и сколько таких групп надо?
Например, тут их по две:

Код:

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

(cons 0 "LWPOLYLINE") 
(cons 100 "AcDbEntity") 
(cons 100 "AcDbPolyline")

(cons 0 "DIMSTYLE")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbDimStyleTableRecord")

А тут уже четыре:

Код:

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

    (cons 0 "DIMENSION") ;*
    (cons 100 "AcDbEntity") ;*
    (cons 100 "AcDbDimension") ;*
    (cons 10 pv)   
    (cons 70 32) ;*
    (cons 51 adim)
    (cons 3 "2-100")
    (cons 100 "AcDbAlignedDimension") ;*
    (cons 13 pn)
    (cons 14 pk)
    (cons 50 adim)
    (cons 100 "AcDbRotatedDimension") ;*

для меня пока самый надежный источник был (entget (car (entsel))) и смотреть что там есть да сравнивать.

[Кулик Алексей aka kpblc]

Vladimir_Sergeevich, скажу честно: я почти всегда создаю через ActiveX - это нередко удобнее (особенно при работе внутри описания блоков или в неактивном документе).
Правда, это не касается размерного стиля - если его создавать или модифицировать лиспом, то кроме как entmake / entmod, ничего не срабатывает (я на autolisp.ru на эту тему как-то высказывался).

[trushev]

Огромное спасибо за ответы!
И еще вопрос по коду 62

(cons 62 (atoi (getvar "cecolor"))) - неудачное решение, getvar может вернуть строку "BYLAYER" или "BYBLOCK". Кроме того, кажется где-то в 2002-2005 версии, встречал возврат не целым числом, а словом с именем цвета. Первое, что приходит в голову - cond с нудным перечислением случаев. Где посмотреть варианты решения?

[Vladimir_Sergeevich]

Сообщение от Кулик Алексей aka kpblc если его создавать или модифицировать лиспом, то кроме как entmake / entmod, ничего не срабатывает

вот я с размерами тоже долго бодался. Хоть ActiveX и удобней в использовании, а тут пришлось через DXF...
Самое интересное, что для групп 50 и 51 в ActiveX свойства есть только для одного (по крайней мере для 50 я в справке не откопал) и даже если поменять 51, картинка не менялась, хотя значение, вроде как, запоминалось.

[Кулик Алексей aka kpblc]

trushev, насколько я помню, если не указывать 62 группу, то примитив создается с текущим цветом (cecolor).
Vladimir_Sergeevich, вариантов на самом деле несколько:
1. Менять свойство Normal для vla-представления примитива. Возможно, потом понадобится выполнить vla-update для примитива
2. Для замены DXF-групп я уже давно использую код http://autolisp.ru/wp-content/upload...-autoregen.lsp + http://autolisp.ru/2013/11/19/partia...-ent-to-ename/ Как правило, хватает.

[RNB]

Сообщение от Кулик Алексей aka kpblc RNB, тебя научить надо? Тогда добро пожаловать (в качестве начального варианта): http://autolisp.ru/2009/09/13/error-catch/ + http://autolisp.ru/2012/03/16/user-request/

Вот что сваял в итоге. Подразумевается, что слой #Вспомогательная у меня есть. Есть какие-то замечания?

Код:

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

 (defun c:xline2 ()
  (command "_clayer" "#Вспомогательная" "_xline")
  (while (> (getvar "CMDACTIVE") 0)
    (if	(= (type
	     (vl-catch-all-apply
	       (function
		 (lambda ()
		   (command pause)
		 ) ;_ end of lambda
	       ) ;_ end of function
	     ) ;_ end of vl-catch-all-apply
	   ) ;_ end of type
	   'list
	) ;_ end of =
      (princ)
      (princ)
    ) ;_ end of if
  ) ;_ end of command
  (command "_layerp")
  (princ)
) ;_ end of defun

И вопросы: что в данном коде даёт (function (lambda ())) ?

[Кулик Алексей aka kpblc]

vl-catch-all-apply (если обратиться к справке) применяет функцию к списку аргументов:
(vl-catch-all-apply 'function list)
Т.е. (vl-catch-all-apply (function (lambda() .... ) - просто другая форма записи (ИМХО - отлаживать такой код проще).

Сообщение от RNB Есть какие-то замечания?

Я не знаю, что хочется получить. Но как вариант:

Код:

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

 (defun c:xl2 (/ pt1 pt2 ang)
  (while (and (= (type
                   (setq pt1 (vl-catch-all-apply (function (lambda () (getpoint "\nПервая точка прямой <Отмена> : ")))))
                   ) ;_ end of type
                 'list
                 ) ;_ end of =
              (= (type
                   (setq pt2 (vl-catch-all-apply (function (lambda () (getpoint pt1 "\nВторая точка прямой <Отмена> : ")))))
                   ) ;_ end of type
                 'list
                 ) ;_ end of =
              ) ;_ end of and
    (setq ang (angle pt1 pt2))
    (entmakex (list '(0 . "XLINE")
                    '(100 . "AcDbEntity")
                    '(100 . "AcDbXline")
                    '(8 . "#Вспомогательная")
                    (cons 10 pt1)
                    (cons 11 (list (cos ang) (sin ang)))
                    ) ;_ end of list
              ) ;_ end of entmakex
    ) ;_ end of while
  ) ;_ end of defun

[RNB]

Сообщение от Кулик Алексей aka kpblc Я не знаю, что хочется получить

Хотелось получить команду, работающую как дефолтная, но в нужном слое. С возвратом первоначального слоя в конце.
В посте #2464 немного другой принцип.

[mkung]

Как проверить в LISP - загружен ли файл ARX, LSP, FAS? Определена ли команда AutoCAD, заданная в файле ARX, LSP, FAS?
Заранее благодарен.

[Кулик Алексей aka kpblc]

Сообщение от mkung загружен ли файл ARX

(arx) - и сверяй результаты

Сообщение от mkung загружен ли файл LSP, FAS

Средствами lisp - никак. Когда-то Александр Ривилис писал arx-приложение, показывающее загрузку lsp.

Сообщение от mkung Определена ли команда AutoCAD, заданная в файле ARX, LSP, FAS?

(atoma-family 1) - может быть, оно сработает как надо

[mkung]

Сообщение от Кулик Алексей aka kpblc (atoma-family 1) - может быть, оно сработает как надо

; ошибка: no function definition: ATOMA-FAMILY

Понял... atoms-family

Вроде и работает, но

(if (member "C:TEXTFIT" (atoms-family 1)) (princ "YES!!!") (princ "NO!!!")) - пишет "YES!!!"

(if (member "C:TXT2MTXT" (atoms-family 1)) (princ "YES!!!") (princ "NO!!!")) - пишет "NO!!!!" хотя функция определена (EXPRESSTOOLS)

[RNB]

Почему во время выполнения кода

Код:

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

 (command "_mleader" pause pause pause)

во время третьей паузы текст вводится в командную строку, а не "по месту", как это происходит при использовании команды "с кнопки"?

[Кулик Алексей aka kpblc]

Советую почитать http://autolisp.ru/2015/01/21/mleader_create_order/ - при создании мультивыноски командными методами можно наступить на очень обидные грабли.

[RNB]

Сообщение от Кулик Алексей aka kpblc Советую почитать http://autolisp.ru/2015/01/21/mleader_create_order/ - при создании мультивыноски командными методами можно наступить на очень обидные грабли.

Это я уже читал. Значение в реестре нужное... Да и точки стрелки и полки ставятся нормально, а вот когда дело доходит до текста, то его ввод перекидывается в командную строку, где пробел или энтер делют ретурн

[RNB]

2 вопроса.
1.

Код:

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

 (defun c:test1 ()
  (command "_-layer"   "_make"	   "-main2"		   "_ltype"
	   "Continuous"		   ""	       "_color"	   "5"
	   ""	       "_lweight"  "0.35"      ""	   ""
	  )
    (setvar "clayer" "0")
  (command "_LAYMRG" "_name" "#main" "" "_Name" "-main2" "_Yes")
  (setvar "clayer" "0")
  (princ "APPLY!")
  (princ)
)

Почему объекты со слоя #main после объединения остаются вообще без слоя, вместо того, чтобы переместиться на слой -main2? При этом объекты находящиеся в блоках ведут себя правильно.
2. Подскажите как программно выделить все объекты на одном слое. Ну или как заморозить все слои кроме текущего.

----- добавлено через ~9 мин. -----
UPD
На вопрос 1 ответ нашел. Проблема в решетке в названии слоя.

[skkkk]

Сообщение от RNB программно выделить все объекты на одном слое

Выделить все объекты слоя указанного объекта:
1. Во всех пространствах:

Код:

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

(sssetfirst nil (ssget "_X" (list (assoc 8 (entget (car (entsel)))))))

2. В текущем пространстве:

Код:

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

(sssetfirst nil (ssget "_X" (list (assoc 8 (entget (car (entsel)))) (cons 410 (getvar "CTAB")))))

Выделить все объекты в текущем пространстве на слое по его имени (вместо "Имя слоя" вписать нужное имя):

Код:

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

(sssetfirst nil (ssget "_X" (list (cons 8 "Имя слоя") (cons 410 (getvar "CTAB")))))

Сообщение от RNB как заморозить все слои кроме текущего

Как-то так:

Код:

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

 (defun C:LAYSFREESE ( / layer-list Table)
(vl-load-com)
	(defun Table (s / d r)
		(while (setq d (tblnext s (null d)))
			(setq r (append r (list (cdr (assoc 2 d)))))
		)
	)
	(setq layer-list (table "LAYER")
		  layer-list (vl-remove (getvar "CLAYER") layer-list)
	)
	(mapcar 
		'(lambda (x)
			(vla-put-Freeze 
				(vla-Item 
					(vla-get-Layers 
						(vla-get-ActiveDocument (vlax-get-acad-object))
					)
					x
				)
				1
			)
		 )
		 layer-list
	)
	(princ)
)

Функция Table найдена когда-то тут на форуме, опубликовал, если не ошибаюсь, Олег (jr.).

[RNB]

Сообщение от skkkk Выделить ...

Спасибо! Буду сидеть разбираться

[gomer]

это ж надо было столько нагородить...

Код:

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

 (defun C:LAYSFREESE ( )
  ( (lambda (x)
     (setvar 'cmdecho 0)
     (command "_.-layer" "_f" "*" "")
     (setvar 'cmdecho x)
    )
    (getvar 'cmdecho)
  )
  (princ)
)