[Mozgunov]

Ребят, помогите. Сделал небольшой лисп для смены цвета слоёв в файле на свои цвета. Программа работает нормально, но на каком-то этапе появляется слой "По Блоку". Не пойму откуда он берётся. Цвета и имена слоёв я храню в текстовом файле. Когда выскакивает этот слой структура этого файла нарушается и конец работы((( Подскажите как он появляется?

Код:

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

 
(vl-load-com)

(defun c:standart ( / )
(setq dcl_id (load_dialog "standart_layer.dcl"))
(new_dialog "long" dcl_id)

(start_list "list_layer")
(mapcar 'add_list (table "layer"))
(end_list)

(mode_tile "primen" 1)
(start_dialog)

(unload_dialog dcl_id)

); defun standart

;;Срабатывает при выборе слоя
(defun sel_layer (n / )
(mode_tile "primen" 0);;Делаю кнопку применить доступной
(setq nomer n);;Запоминаю номер выбранного слоя в List

;;Запоминаю цвет выбранного слоя
(setq clr (cdr(assoc 62 (entget(tblobjname "LAYER" (nth (atoi nomer)(table "layer")))))))
;;Запоминаю имя выбранного слоя
(setq name_layer (cdr(assoc 2 (entget(tblobjname "LAYER" (nth (atoi nomer)(table "layer")))))))
;;Закрашиваю кнопку выбора слоя
(start_image "color_box")
(fill_image 0 0 1000 1000 clr)
(end_image)
);;end_of_sel_layer


(defun primen( / i )
(mode_tile "primen" 1)
(setq aa nil)
; проверка существования файла
    (setq f (findfile "standart_layer.txt"))
 ; если существует 
    (if (/= f nil)

      (progn
 ; открытие существующего файла
          (setq fk (open f "r")
             aa(list)
             a (read-line fk))
 ; цикл с проверкой конца файла
          (while (/= a nil)
 ; добавление элемента в список
             (setq aa (append aa (list a)))
 ; чтение следующего
             (setq a (read-line fk))
          )
 ; закрытие файла 
          (close fk)
       )

   )
 
 (if (and (/= name_layer nil) (/= clr nil) (/= clr 0) (/= clr 256))
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (= (vl-position name_layer aa) nil)

(progn
(setq aa (append aa (list name_layer)))
(setq aa (append aa (list (itoa clr))))
);;если нет в aa


(progn
(setq pos (vl-position name_layer aa))
(setq aa (vl-remove name_layer aa ))
(setq aa (vl-remove (nth pos aa) aa ))
;;(vl-remove (+ (vl-position name_layer aa) 1) aa )
(setq aa (append aa (list name_layer)))
(setq aa (append aa (list (itoa clr))))
);;если есть в aa
) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
);;end_if

   

; проверка существования файла
    (setq f (findfile "standart_layer.txt"))
 ; если существует 
    (if (/= f nil)
      (progn
	  (vl-file-delete f)
	  (setq i 0)
 ; открытие существующего файла для записи 
          (setq fk (open f "W"))
 
 ; цикл с проверкой конца файла
          (repeat (length aa)
          (write-line (nth i aa) fk)
		  (setq i (+ i 1))
          )
 ; закрытие файла 
          (close fk)
       )

   )
   
   
 (perekras)  
   
);;end_of_primen




(defun Table (s / d r)
(while (setq d (tblnext s (null d)))
(setq r (append r (list (cdr (assoc 2 d)))))
)
)

(defun sel_col( / )
(setq clr (acad_colordlg 1))
(if (= clr 256)
(progn
(alert "Не допустимы значения 'По слою.'\nНазначен красный цвет.\nПовторите выбор.")
(setq clr 1)
)
);end_of_if

(if (= clr 0)
(progn
(alert "Не допустимы значения 'По блоку.'\nНазначен красный цвет.\nПовторите выбор.")
(setq clr 1)
)
);end_of_if


(start_image "color_box")
(fill_image 0 0 1000 1000 clr)
(end_image)
)



 (defun perekras ( / i)
 (setq i 0)
 (repeat (/ (length aa) 2)
 (setq le (entget (tblobjname "LAYER" (nth i aa))))
 (if (/= le nil)
 (progn
 (setq le (subst (cons 62 (atoi (nth (+ i 1) aa))) (assoc 62 le) le))
 (entmod le)
 )
 );end_of_if
 
 (setq i (+ i 2))
 )
		  
(start_list "list_layer")
(mapcar 'add_list (table "layer"))
(end_list)
 )



 (defun zakras ( / i) 
 
 (setq aa nil)
; проверка существования файла
    (setq f (findfile "standart_layer.txt"))
 ; если существует 
    (if (/= f nil)

      (progn
 ; открытие существующего файла
          (setq fk (open f "r")
             aa(list)
             a (read-line fk))
 ; цикл с проверкой конца файла
          (while (/= a nil)
 ; добавление элемента в список
             (setq aa (append aa (list a)))
 ; чтение следующего
             (setq a (read-line fk))
          )
 ; закрытие файла 
          (close fk)
       )

   )
   (perekras)
 );end_of_zakras
 
 
 
 (defun neizv ( / i)
 (setq i 0)
 (repeat (length (table "layer")) 
 (setq le (entget (tblobjname "LAYER" (nth i (table "layer")))))
 (setq le (subst (cons 62 80) (assoc 62 le) le))
 (entmod le)
 (setq i (+ i 1))
 )
 (zakras)
)
 

[gomer]

Имя слоя читается как цвет слоя, проверьте список aa на разных этапах выполнения программы, а вообще это очень унылый код

[Mozgunov]

gomer, Спасибо. Как умею)) Лучше унылый чем никакой)

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

А не проще попытаться использовать dws?

[Mozgunov]

Вообщем никто не хочет смотреть мою дрябедень)) Спасибо, Алексей. Посмотрю.

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

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

[Mozgunov]

Сообщение от Кулик Алексей aka kpblc Мне, например, просто некогда. Если повезет - вечером попробую глянуть (хотя, учитывая объем задачек на ближайшую неделю, времени у меня ни на что более-менее серьезное не будет).

Спасибо, Алексей. Я понимаю какой у вас объём работ. Да мне gomer в принципе правильно сказал. Постараюсь сам найти.

[Лиспер]

Интересно, а что там в dcl творится?

[Nike]

Сообщение от gomer а вообще это очень унылый код

А это хуже чем "печальный программизм"?

[Mozgunov]

Лиспер, Туда лучше не лезть)) Ладно, ребят) Погорячился я что задал вопрос. Сам разберусь. Всем спасибо за комментарии.

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

По-быстрому, с минимальным количеством прогонов. Без обработки диалога (которого нет )
C кодом, думаю, разберешься - особо сложного там ничего нет (кроме, как мне тут сказали, излишнего количества проверок и защит от ошибок )

[Mozgunov]

Алексей, большое спасибо. Сейчас буду разбираться. Выкладываю что у меня получилось. Конечно очень "унылый" код, без проверок, но работает вроде.