[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

_____________________________________________________________________________________________________________

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

[Aminka]

Привет еще раз. Есть код программки для рисования блоков с тексотвыми атрибутами, значения которых считывается из файла. Блоки уже определены в текущем чертеже. Однако, не могу справиться с двумя проблемами: 1. блоки вставляются посредством (command "insert"...), но тока вставки блока на чертеж после отработки программки не соответствует задаваемой в программе. 2. На чертеже не отображается текст.
Господа гуру, объянсите, пожалуйста, что не так и как это можно исправить? Сразу оговорюсь, что это мой первый опыт знакомства с автолиспом и в дебри объектного автолиспа еще не влезала.

[VVA]

Aminka, Непонятен принцип формирования схем и отсутсвует текстовый файлик, поэтому чтение из файла закоментировал, недостающие переменные проинициалировал, ошибки выделил

Код:

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

(defun c:stpoj04 (/ Nizv i inc);в скобках указаны пременные
   (setq temp "y")  ;temp="y"-строковая переменная(да,Yes)
   (setq fname nil fileh nil) ;обнуляет две переменные
;;;!!!   (princ "\nВыберите файл с данными")
;;;!!!   (setq fname (getfiled "Output filename" "" "txt" 0));(getfiled "строка-запрос""путь" "расширение" "режим")Взятие имени файла
;;;!!!   (setq fileh (open fname "r"))
   (setq Nizv nil)
   (setq inc nil)
   (setq point nil)
   (setq point0 nil)
   (setq pointstart nil)
   (setq dpoint nil)
   (setq i nil)
   (setq j nil)
   (setq Nryad nil)
   (setq Npom nil)
   (setq Ndatch nil)
   (setq datch nil)
   (setq pppp nil)
 
   (setq j 1)
   (setq i 1)
   (setq dlx 1000)
   (setq dly 2000)
   (setq dlbl 600)
   (setq pppp (/ dlbl 2))
;;;!!!   (setq Nizv (atoi(read-line fileh)))
(setq Nizv 5)  ;;;!!! Просто проинициализировать
   (setq Nryad (atoi(getstring "\nВведите количество датчиков в ряду  ")
		    ))
  (if (>= Nryad Nizv) (setq Nryad Nizv))
   (setq pointstart (getpoint "Выберите начальную точку схемы "))
   (setq point0 pointstart)  
   (setq point (list (+ dlx (car point0)) (cadr point0)))
  
  (setq flag1 T)
  (while (<= i Nizv)
     (setq j 1)
          (while (<= j (+ Nryad 1))
            (entmake
             (list	;; формируем ассоциированный список
	      '(0 . "LWPOLYLINE");; Тип примитива
	      '(100 . "AcDbEntity");; Маркер подкласса
              '(100 . "AcDbPolyline");; Маркер подкласса
	      '(90 . 2)	;; Количество вершин
              '(43 . 0.3);; Толщина
	       (cons 10 point0);; Точка вершины 1
	       (cons 10 point);; Точка вершины 2
	     ) ;_ end of list
            ) ;_ end of entmake
                

          (if (<= j Nryad)
	  (progn  
;;; !!!!         (setq datch (read-line fileh))
;;;  !!!	  (setq Npom (read-line fileh))
(setq datch "ручник");;;!!! Просто проинициализировать	    
(setq Npom "Npom");;;!!! Просто проинициализировать	    
	(setq dpoint nil)
	(setq dpoint (list (+ 300 (car point)) (cadr point)))	  
	(setq p0 (list (- (car dpoint) 400) (- (cadr dpoint) 800)))
	(entmakex (list
		   '(0 . "TEXT")
		   '(100 . "AcDbEntity")
		   '(100 . "AcDbMText")
		   '(40 . 250.0)
                   (cons 41 0.6)
                   '(7 . "StandarD") ;_ Вопрос 2
		   '(71 . 5)
		   (cons 10 p0)
		   (cons 1 (strcat "пом." Npom))
		   )
		 )
	  	  
;;; !!!!	  (setq Ndatch (read-line fileh))
(setq Ndatch "555");;;!!! Просто проинициализировать
	  (setq dpoint nil)
	  (setq dpoint (list (+ 300 (car point)) (cadr point)))
	  
	  (command "_-INSERT" datch "_non" dpoint "" "" "")
          (command Ndatch)

	    (setq p1 (list (- (car dpoint) 400) (- (cadr dpoint) 350)))
	    (setq p2 (list (- (car dpoint) 400) (- (cadr dpoint) 500)))
	    (setq p3 (list (+ (car dpoint) 400) (- (cadr dpoint) 500)))
	    (setq p4 (list (+ (car dpoint) 400) (- (cadr dpoint) 250)))
	  
            (entmake
             (list	;; формируем ассоциированный список
	      '(0 . "LWPOLYLINE");; Тип примитива
	      '(100 . "AcDbEntity");; Маркер подкласса
              '(100 . "AcDbPolyline");; Маркер подкласса
	      '(90 . 4)	;; Количество вершин
              '(43 . 0.1);; Толщина
	       (cons 10 p1);; Точка вершины 1
	       (cons 10 p2);; Точка вершины 2
	       (cons 10 p3)
	       (cons 10 p4)
	      ) ;_ end of list
            ) ;_ end of entmake
	                
	  
	  (setq i (+ i 1))
          );end of progn
	  )  
           (setq j (+ j 1))
	    
	   (setq point0 (list (+ dlbl (car point)) (cadr point0))) 
           (setq point (list (+ dlx (car point0)) (cadr point0)))    
                   	    
           (if (AND (= i (+ Nizv 1)) (= flag1 T))
             (progn
	       (setq j (+ Nryad 1))
               (setq flag1 nil))
	     )  	       
     ) ;end of if while j
      
   (setq point0 (list (car pointstart) (- (cadr point0) dly)))
   (setq point (list (+ dlx (car point0)) (cadr point0))) 
   );end of if while i
(setq Nryad Nryadtmp)
   
);end of defun
(princ)

1. Непонятно зачем в команде INSERT использовалась опция "Base point"
2. Не отключались привязки в INSERT ("_non")
3. Учти что INSERT вставляет блоки в точки ТЕКУЩЕЙ ПСК, а entmake создает полилинии и тексты в точках МСК. Короче если текущая система координат отлична от мировой будут проблемы.

[Red Nova]

Подскажите пожалуйста как добавить элемент в конец списка, а-то я нашел только cons, а им можно только в начало добавить. Или каждый раз нужно реверс списка делать туда-сюда?

[Дима_]

(append )

[Red Nova]

Спасибо.
Не могу справится с одной задачкой. Имею список такого типа

Код:

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

(("Арматура АI" ("ГОСТ 5781-82" ("Арматура d= 6"))) 
("Арматура АIII" ("ГОСТ 5781-82" ("Арматура d= 6" "Арматура d= 8"))))

При этом элементов может быть неограниченное число.
Требуется видоизменить последний элемент и добавить к нему элемент "Арматура d= 10"
То есть в итоге должен получить.

Код:

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

(("Арматура АI" ("ГОСТ 5781-82" ("Арматура d= 6")))
 ("Арматура АIII" ("ГОСТ 5781-82" ("Арматура d= 6" "Арматура d= 8" "Арматура d= 10"))))

Как ни кручу не получается.

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

Если структура списка известна заранее, то многократно вложенный subst тебе поможет. Вкупе с append

[Red Nova]

А можно на конкретном примере с #645?

[Дима_]

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

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

Дима_, я уже писал #636
Red Nova, код получится практически нечитабельным (да и чертовски неустойчивым), если не применять рекурсию. Оно тебе надо?

[Дима_]

Код:

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

(defun recadd (lst el appel)
(apply 'append (mapcar '(lambda (tmp)
(if (= tmp el) (cons tmp appel) 
(if (= (type tmp) 'list) (list (recadd tmp el appel)) (list tmp)))
);end of lambda 
lst))
);end of recadd

Если тебя предыдущие посты не испугали вот рекусривная функция, добавляет элементы appel после каждого элемента el в любом подсписке списка lst. Но еще раз предупреждаю т.к. избыточность у тебя неимоверная применение ее выглядит весьма сомнительно.

То есть при запуске

Код:

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

(recadd '("Арматура АI" ("ГОСТ 5781-82" ("Арматура d= 6"))) "Арматура 
d= 6" '("Арматура d= 8" "Арматура d= 10"))

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

Код:

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

("Арматура АI" ("ГОСТ 5781-82" ("Арматура d= 6" "Арматура d= 8" "Арматура d= 10")))

, но если в этом-же списке встретится и другой гост с аналогичным именем "Арматура d= 6", он тоже будет изменем на d6+d8+d10. Вобщем граблей при таком подходе больше чем кажеться на первый раз, еще раз советую менять структуру хранения данных - пока не поздно.

[Aminka]

VVA спасибо, отключение привязок помогло)). Вопрос - почему при включенных привязках игнорируется точка вставки блока, напрямую задаваемая в INSERT и какая точка используется для вставки? я пробовала перед выполнением INSERT рисовать точку, но к ней блок не "привязывался".

[VVA]

Aminka,

Вопрос - почему при включенных привязках игнорируется точка вставки блока, напрямую задаваемая в INSERT

Она не игнорируется. Это называется Грабли №1(обработка OSMODE) Почитай эту тему с поста эдак #167(можно на страничку раньше начать)

[Red Nova]

Спасибо за советы. Менять структуру хранения данных я буду только в самом тупиковом варианте. Просто уже многое сделано. Я ведь не все вам показываю.
Все таки по моему вы меня неверно поняли.
В списке структура всегда одинаковая.
Список может быть такой

Код:

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

(("Арматура АI" ("ГОСТ 5781-82" ("Арматура d= 6"))) 
("Арматура АIII" ("ГОСТ 5781-82" ("Арматура d= 6" "Арматура d= 8"))))

Или такой

Код:

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

(("Арматура АIII" ("ГОСТ 5781-82" ("Арматура d= 6" "Арматура d= 8")))
)

Но всегда "в глубину" количество подсписков одинаковое.
Так вот требуется Взять из этого списка последний подсписок, это

Код:

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

("Арматура АIII" ("ГОСТ 5781-82" ("Арматура d= 6" "Арматура d= 8")))

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

Код:

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

("Арматура d= 6" "Арматура d= 8")

И добавить в него новый элемент. Уверен что этот путь можно пройти без грабель.


Добавлено.
Все, разобрался. Вчера меня заклинило, а сегодня получилось.

Код:

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

		      (setq list_sip
			     	(if (= (length list_sip) 1)
					(list (list (car (car list_sip))
					      (append (list (car (cadr (car list_sip))))
						      (list (append (car (cdr (cadr (car list_sip))))
							(list (nth count_etalon_profil (car (cdr (car (cdr (nth count_etalon etalon))))))))))))
				  
					(append
					  	(reverse (cdr (reverse list_sip)))
						(list (list (car (car (reverse list_sip)))
							(append (list (car (cadr (car (reverse list_sip)))))
								 (list (append (car (cdr (cadr (car (reverse list_sip))))) (list (nth count_etalon_profil (car (cdr (car (cdr (nth count_etalon etalon)))))))))))))
				       );_end of if
			    	);_end os setq

Тут
list_sip
это наш список, а
(nth count_etalon_profil (car (cdr (car (cdr (nth count_etalon etalon))))))
И есть добавляемый элемент.
Как всегда неуклюже, но работает

[Diman111]

Подскажите кодом, пожалуйста .
есть некая программка с использванием немодального OpenDCL диалога - т.е. она всегда висит на экране. программно создаются примитивы - тут все ровно. Загвоздка на этапе объединения их в безымянную группу. ранее применялся код

Код:

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

(VL-CMDF "_.-GROUP" "_C" "*" "бла бла" nabor:prim "")

И все работало. Но то было без OpenDCL окон. сейчас получаю ошибку

Код:

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

; error: invalid AutoCAD command: nil

переменная naborrim содержит набор номер такойто, вида

Код:

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

<Entity name: 7ed4cd10><Entity name: 7ed4cd10><Entity name: 7ed4cd10>

Причин такого поведения не нашел и решил просто программно создать группу.
Подскажите примерчик, пожалуйста

[CB]

>Red Nova

Код:

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

(setq lst
       '(("Арматура АI" ("ГОСТ 5781-82" ("Арматура d= 6")))
         ("Арматура АIII"
          ("ГОСТ 5781-82" ("Арматура d= 6" "Арматура d= 8"))
         )
        )
) ;_ end of setq
((lambda (a b)
   (subst
     (list (car a)
           (list (caadr a) (cons b (cadadr a)))
     ) ;_ end of list
     a
     lst
   ) ;_ end of subst
 ) ;_ end of lambda
  (last lst)
  "Арматура d= 10"; добавляемый элемент
)

[VVA]

Red Nova, Особо не проверял, но вроде работает

Код:

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

(defun test (Klass GOST Arm lst / tmp1 tmp2 tmp3)

;;;Если Нет Класса арматуры или ГОСТА, то они создаются
;;;Klass - класс арматуры, сторока вида "Арматура АI"
;;;GOST- ГОСТ арматуры, строка вида "ГОСТ 5781-82"
;;;Arm - сама арматура, строка вида "Арматура d= 12"
;;;lst - список вида
;;;(setq lst
;;;       '(("Арматура АI" ("ГОСТ 5781-82" ("Арматура d= 6")))
;;;         ("Арматура АIII"
;;;          ("ГОСТ 5781-82" ("Арматура d= 6" "Арматура d= 8"))
;;;         )
;;;        )
;;;) ;_ end of setq
;;;Пример 
;;;(setq ret (test "Арматура АIII" "ГОСТ 5781-82" "Арматура d= 10" lst))
;;;(setq ret (test "Арматура АIII" "ГОСТ YYY-YYY" "Арматура d= 12" lst))
;;;(setq ret (test "Арматура А??" "ГОСТ NNN" "Арматура d= 12" lst))

  (if (setq tmp1 (assoc Klass lst))
    (progn
      (if (setq tmp2 (assoc GOST (cdr tmp1)))
	(progn
	  (if (null (assoc arm (cdr tmp2)))
	    (setq tmp3
		   (subst (list GOST (append (cadr tmp2) (list arm)))
			  tmp2
			  (cdr tmp1)
		   )
	    )
	    (setq tmp3 (cdr tmp1))
	  )
	  (setq	lst
		 (subst	(append (list Klass) tmp3)
			(assoc Klass lst)
			lst
		 )
	  )
	)
	(progn
	  (setq tmp1 (append tmp1 (list (list GOST (list arm)))))
	  (setq	lst
		 (subst tmp1 (assoc Klass lst) lst)
	  )
	)
      )
    )
    (setq lst (append lst (list (list Klass (list GOST (list arm))))))

  )
  lst
)

Пример. Если Нет Класса арматуры или ГОСТА, то они создаются

Код:

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

(setq lst
       '(("Арматура АI" ("ГОСТ 5781-82" ("Арматура d= 6"))
	                ("ГОСТ XXX-XX" ("Арматура d= 6"))
	  )
         ("Арматура АIII"
          ("ГОСТ 5781-82" ("Арматура d= 6" "Арматура d= 8"))
	  ("ГОСТ YYY-YYY" ("Арматура d= 6" "Арматура d= 8"))
         )
	 
        )
) ;_ end of setq
;;;Добавляем d10
(setq ret (test "Арматура АIII" "ГОСТ 5781-82" "Арматура d= 10" lst))
;;;Добавляем d12
(setq ret (test "Арматура АIII" "ГОСТ YYY-YYY" "Арматура d= 12" lst))
(setq ret (test "Арматура А??" "ГОСТ NNN" "Арматура d= 12" lst))

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

Diman111, попробуй найти код по очистке групп и сделай группировку некомандными методами (там на самом деле достаточно просто, насколько мне помнится)
P.S. С OpenDCL лично я не работал

[Diman111]

Кулик Алексей aka kpblc, Вот пример создания группы программным методом я бы с удовольствием посмотрел.
Если у кого в закромах найдется - поделитесь, пожалуйста.

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

Как вариант, написано "на коленке" с минимумом проверок:

Код:

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

(defun create-group-by-selset (selset name / adoc groups new_group lst_groups _kpblc-conv-vla-to-list)

                              ;|
	selset	набор примитивов
	name	имя группы. Если такая группа уже есть, то выполнение прекращается
		nil недопустим. Имя со звездочкой ("*") недопустимо
|;

  (defun _kpblc-conv-vla-to-list (value / res)
                                 ;|
*    Преобразовывает vlax-variant или vlax-safearray в список.
|;
    (cond
      ((listp value)
       (mapcar '_kpblc-conv-vla-to-list value)
       )
      ((= (type value) 'variant)
       (_kpblc-conv-vla-to-list (vlax-variant-value value))
       )
      ((= (type value) 'safearray)
       (if (>= (vlax-safearray-get-u-bound value 1) 0)
         (_kpblc-conv-vla-to-list (vlax-safearray->list value))
         ) ;_ end of if
       )
      ((and (= (type value) 'vla-object)
            (vlax-property-available-p value 'count)
            ) ;_ end of and
       (vlax-for sub value
         (setq res (cons sub res))
         ) ;_ end of vlax-for
       )
      (t value)
      ) ;_ end of cond
    ) ;_ end of defun

  (vl-load-com)

  (setq adoc       (vla-get-activedocument (vlax-get-acad-object))
        groups     (vla-get-groups adoc)
        lst_groups (_kpblc-conv-vla-to-list groups)
        ) ;_ end of setq
  (if (not (setq new_group (vl-remove-if-not
                             (function
                               (lambda (x)
                                 (= (strcase (vla-get-name x)) (strcase name))
                                 ) ;_ end of lambda
                               ) ;_ end of function
                             lst_groups
                             ) ;_ end of vl-remove-if-not
                 ) ;_ end of setq
           ) ;_ end of not
    (progn
      (vla-startundomark adoc)
      (vl-catch-all-apply
        (function
          (lambda ()
            (vlax-invoke-method
              (setq new_group (vla-add groups name))
              'appenditems
              (vlax-make-variant
                (vlax-safearray-fill
                  (vlax-make-safearray
                    vlax-vbobject
                    (cons 0 (1- (sslength selset)))
                    ) ;_ end of vlax-make-safearray
                  (mapcar (function vlax-ename->vla-object)
                          ((lambda (/ tab item)
                             (repeat (setq tab  nil
                                           item (sslength selset)
                                           ) ;_ end setq
                               (setq tab (cons (ssname selset (setq item (1- item))) tab))
                               ) ;_ end repeat
                             tab
                             ) ;_ end of lambda
                           )
                          ) ;_ end of mapcar
                  ) ;_ end of vlax-safearray-fill
                ) ;_ end of vlax-make-variant
              ) ;_ end of vlax-invoke-method
            ) ;_ end of lambda
          ) ;_ end of function
        ) ;_ end of vl-catch-all-apply
      (vla-endundomark adoc)
      ) ;_ end of progn
    ) ;_ end of if
  new_group
  ) ;_ end of defun

[VVA]

Diman111, Про группы еще здесь