[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

_____________________________________________________________________________________________________________

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

[andery]

Alaspher
Спасибо, то что нада

[Red Nova]

Отбился я от рук. Работа...
kpblc,
Твой лисп я таки понял, но как синхронизировать его с "колонной". Я топорно вставил, и пока не работает.

Код:

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

(defun C:колонна (/ dimensionX dimensionY oldOSM OldLAY get_nil pt0 pt1 selset res x y)

 (defun *error*(msg) 
 (princ msg) ; Отменено пользователем
 (if oldOSM (setvar "osmode" oldOSM)) 
 (if OldLAY (setvar "clayer" OldLAY)) 
 ) 

 (setq OldLAY (getvar "clayer"))

 (setq oldOSM (getvar "osmode"))

 (setvar "osmode" 0)

 (initget 7)
 (setq dimensionX (getreal "Введите ширину колонны: "))
 (initget 7)
 (setq dimensionY (getreal "Введите толщину колонны: "))

 (if (not (tblsearch "block" "Колонна"))
   (progn
     (command "_-layer" "_set" "0" "")
     (command "_rectang" "-0.5,-0.5" "0.5,0.5")
     (command "_chprop" "_last" "" "_color" "_byblock" "_ltype" "_byblock" "_lweight" "_byblock" "")
     (command "_-block" "Колонна" "0,0" "_last" "")
   )
 )

 (command "_-layer" "_make" "Колонна" "")

 (setq get_nil t) ;_Устанавливаем флаг
(while get_nil
  (princ "\Укажите ТОЧКУ (ENTER-Хватит):")
  (command "_-insert" "Колонна" "_x" dimensionX "_y" dimensionY "0,0" "")
  (setq pt0 (getvar "lastpoint"))
  (setq blk (entlast))
  (command "_change" blk "" "" pause)
  (setq pt1 (getvar "lastpoint"))
 (if (equal pt0 pt1 0.000001)
    (progn
      (command "") ;_Завершаем команду Change нажатием Enter
      (entdel blk)
      (setq get_nil nil) ;_Сбрасываем флаг
     ) ;_ end of progn
    (progn
      (command pause) ;_Завершаем команду Change. Ждем от пользователя указания угла поворота
      (command "_circle" (getvar "lastpoint") (/ dimensionX 2) "")
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of while

 (setvar "clayer" OldLAY)

 (setvar "osmode" oldOSM)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  (if (setq selset (ssget '((0 . "INSERT") (2 . "Колонна"))))
    (foreach item (_dwgru-conv-pickset-to-list selset)
      (if (member (setq size (strcat (rtos (cdr (assoc 41 (entget item))) 2 4)
                                     "x"
                                     (rtos (cdr (assoc 42 (entget item))) 2 4)
                                     ) ;_ end of strcat
                        ) ;_ end of setq
                  (mapcar 'car res)
                  ) ;_ end of member
        (setq res (subst (cons size (1+ (cdr (assoc size res))))
                         (assoc size res)
                         res
                         ) ;_ end of subst
              ) ;_ end of setq
        (setq res (cons (cons size 1) res))
        ) ;_ end of if
      ) ;_ end of foreach
    ) ;_ end of if

 )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun _dwgru-conv-pickset-to-list (value / tab item)
  (repeat (setq tab  nil
                item (sslength value)
                ) ;_ end setq
    (setq tab (cons (ssname value (setq item (1- item))) tab))
    ) ;_ end repeat
  ) ;_ end defun

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

А в каком именно месте не работает? по-моему (код не тестировал - не до того ) все работает, только никуда результат не выводится

[Red Nova]

А я не знаю как.

[Red Nova]

kpblc
Знаю что нужно использовать prompt, но правильно записать (и где) понять не могу.

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

можно, конечно, и prompt. Но я б использовал princ.
Извини, у меня сейчас запарка, я отвечать осмысленно врд ли смогу

[Red Nova]

Пдаждемс

[andery]

Решил для себя написать такой лисп.
Данный листп создает стили шрифтов (шрифт ISOCPEUR и его курсив) от вводимого минимального размера до максимального с заданным интервалом.

Код:

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

(defun c:шрифт (/)
    	(initget (+ 1 2 4))
  	(setq min_T (getint "Введите минимальную высоту шрифта:"))
  	(initget (+ 1 2 4))
  	(setq max_T (getint "Введите максимальную высоту шрифта:"))
  	(initget (+ 1 2 4))
  	(setq I (getint "Введите интервал между создаваемыми шрифтами:"))
  	(While (>= max_T min_T)
	  	(progn
		  (setq tt (strcat "gost" (itoa min_T)))
		  (setq ttk (strcat "gost" (itoa min_T) "(курсив)"))
		  (command "_-style" tt "ISOCPEUR" min_T "1" "0" "_n" "_n")
		  (command "_-style" ttk "isocpeui.ttf" min_T "1" "0" "_n" "_n")
		  (setq min_T (+ min_T I))
		) ;;end of progn  
	) ;;end of while
  	(setq tt (strcat "gost" (itoa max_T)))
	(setq ttk (strcat "gost" (itoa max_T) "(курсив)"))
  	(command "_-style" tt "ISOCPEUR" max_T "1" "0" "_n" "_n")
	(command "_-style" ttk "isocpeui.ttf" max_T "1" "0" "_n" "_n")
);;end of defun

Возник такой вопрос, хотелось бы чтоб лисп был универсальный и создавал шрифты и с десятичной высотой (0.5, 1.0, 1.5....)
Но itoa понимает тока целые числа, может есть какой то выход ? или надо игратся с переносом нуля, отделением цело или десятичной части .....

[andery]

Нашел выход с rtos
(rtos <число> [<режим> [<точность>]]) - преобразование вещественного числа в строку;
Ну значит прошу заценить код:

Код:

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

(defun c:шрифт (/ min_T max_T I tt ttk)
    	(initget (+ 1 2 4))
  	(setq min_T (getreal "Введите минимальную высоту шрифта:"))
  	(initget (+ 1 2 4))
  	(setq max_T (getreal "Введите максимальную высоту шрифта:"))
  	(initget (+ 1 2 4))
  	(setq I (getreal "Введите интервал между создаваемыми шрифтами:"))
  	(While (>= max_T min_T)
	  	(progn
		  (setq tt (strcat "gost" (rtos min_T)))
		  (setq ttk (strcat "gost" (rtos min_T) "(курсив)"))
		  (command "_-style" tt "ISOCPEUR" min_T "1" "0" "_n" "_n")
		  (command "_-style" ttk "isocpeui.ttf" min_T "1" "0" "_n" "_n")
		  (setq min_T (+ min_T I))
		) ;;end of progn  
	) ;;end of while
  	(setq tt (strcat "gost" (rtos max_T)))
	(setq ttk (strcat "gost" (rtos max_T) "(курсив)"))
  	(command "_-style" tt "ISOCPEUR" max_T "1" "0" "_n" "_n")
	(command "_-style" ttk "isocpeui.ttf" max_T "1" "0" "_n" "_n")
);;end of defun

[Alaspher]

Сообщение от andery Ну значит прошу заценить код

Можно немного упростить не меняя функциональность:

Код:

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

(defun c:шрифт (/ min_t max_t i tt)
 (initget (+ 1 2 4))
 (setq min_t (getreal "\nВведите минимальную высоту шрифта: "))
 (initget (+ 1 2 4))
 (setq max_t (getreal "\nВведите максимальную высоту шрифта: "))
 (initget (+ 1 2 4))
 (setq i (getreal "\nВведите интервал между создаваемыми шрифтами: "))
 (while (>= max_t min_t)
  (setq tt (strcat "gost" (rtos min_t)))
  (vl-cmdf "_-style" tt "ISOCPEUR" min_t 1 0 "_n" "_n")
  (vl-cmdf "_-style" (strcat tt "(курсив)") "isocpeui.ttf" min_t 1 0 "_n" "_n")
  (setq min_t (+ min_t i))
 )
 (princ)
)

[andery]

(vl-cmdf "_-style" tt "ISOCPEUR" min_t 1 0 "_n" "_n") (vl-cmdf "_-style" (strcat tt "(курсив)") "isocpeui.ttf" min_t 1 0 "_n" "_n")

вот vl-cmdf - мне пока не знакомо...

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

Практически аналог (command). Единственное отличие в AutoCAD - при успешном завершении возвращает t (command возвращает nil независимо ни от чего).

[Alaspher]

Есть ещё одно важное отличие - vl-cmdf вычисляет аргумент перед передачей и если возникает ошибка, то аргумент не передаётся (соответственно не возникает ошибка команды, которую ЛИСП обработать уже не может), а command валит аргументы в комстроку не глядя.

[andery]

а команды с приставкой vl- это уже из какой "оперы"?
И когда к ним стоит переходить?

[Дима_]

vl - visual lisp, а переходить к ним надо когда не хочешь изобретать велосипед, например если надо объем померить, или таблицу заполнить - можно и через dxf, но муторно да и незачем.

[Alan]

Сообщение от andery они не поддерживают украинский язык Стоит ли искать ответ на заданный вопрос или пока забыть об этом?

Есть несколько shx шрифтов, которые прекрасно поодерживают украинский язык, а russ14.shx еще и верхний/нижний индекс и знак номера - №
Зайдите к Поспелову http://cadhlp.kulichki.com/pgtxt.htm возьмите russ-pg.shx и будет Вам счастье.

[Red Nova]

Предлагаю возобновить обучение чайников.
Мне хотелось бы научиться работать со списками. По соседству я начал тему про копирование данных из выносок СПДС в спецификацию из мтекстов. Крыс написал функцию преобразующую содержание позиционных выносок в набор. Теперь следующим шагом должна быть фильтрация ненужной информации и модификация списка. Чему собственно и хотелось бы научиться.
Предположим имеем такой список:

(("1" "Тр. Ø89х3.5, L=2500") ("Труба" "") ("2" "-10х100x100") ("3" "Уголок 75х5, L=800") ("4" "Швеллер 20") ("" "Швеллер") ("Труба" "бесшовная") ("2 окна" "класса а") ("5" "Проем") ("6" "Стекловата"))

Со списком нужно произвести ряд операций.
В первую очередь нужно отфильтровать ненужные элементы списка.
Элементы которые нужно оставить должны удовлетворять следующим пунктам.
1. Данные должны содержать оба элемента пары.
То есть элементы ("Труба" "") и ("" "Швеллер") нужно удалить из списка, так как они не удовлетворяют указанному условию.
2. Верхняя строка выноски (первый элемент пары) должна содержать информацию нумерационного характера, нумерация отсчитывается по цифрам и по буквам латинского и русского алфавитов. Можно использовать знак ‘ и “. Допускаемые записи могут иметь такой вид – 1, 2, 3, 4, // а, б, в, г, // a, b, c, d, // 1a, 1b, 1c, // 1, 1’, 1”, 2, 2’ // a1, a2, a3, b, b1, ...
То есть на данном этапе отсеваются элементы
("Труба" "бесшовная") ("2 окна" "класса а"))
3. Нижняя строка должна начинаться на определенные символы, вот их список
- Знак “-”, слова “Лист” и “Полоса”
- Слово “Труба”, “Тр.” и знак трубы из шрифтов СПДС
- Слово “Уголок” и аналогичные символы из шрифтов СПДС
- Слово “Двутавр” и аналогичные символы из шрифтов СПДС
- Слово “Швеллер” и аналогичные символы из шрифтов СПДС
- Слово “Фланец”, то же “Фл.”
- Стандартный знак диаметра и знак диаметра из шрифтов СПДС
- Символ квадратной трубы из шрифтов СПДС
То есть на данном этапе отсеваются элементы
("5" "Проем") ("6" "Стекловата"))

В результате остается список из элементов
(("1" "Тр. Ø89х3.5, L=2500") ("2" "-10х100x100") ("3" "Уголок 75х5, L=800") ("4" "Швеллер 20"))

Ясно что тут пригодятся car и cdr. Но как пройтись по всему списку и самое главное как правильно задать фильтр я не знаю. Был бы благодарен если кто-нибудь напишет хоть один пример фильтрации из вышеприведенного списка, тогда я пойду по подобию, может даже удачно.

[Дима_]

А в чем сложность то? Напиши функцию которая распознает элемент по заданным критериям (parsing) и
(foreach tmp lst
(if (parsing tmp) (setq newlst (append newlst tmp)))
)
П.С. написанно без проверки, но суть я думаю ясна

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

Уж лучше тогда использовать (vl-remove-if) или (vl-remove-if-not) ...

[Red Nova]

Дима_,

А в чем сложность то?

Сложность в том, что я пока этого не умею. Почитаю про parsing
kpblc Если можно, то хотелось бы без vla обойтись.