АВТОЛИСП - РАЗГАДКА ПРОЕКТНОГО АВТОКАДА. Тема 5 - Этап создания таблицы данных пожарной сигнализации. WWW.CAD.DP.UA

Тема 5 Этап создания таблицы данных пожарной сигнализации

Программа построения таблицы ПС с использованием данных информационных текстовых файлов, хранящихся на диске.

(defun 1_dvg();установка данных с плана в таблицу
;пож.сигнализации КДЛ
(princ "================ 1_dvg НАЧАЛО ================")(terpri)
(setq dan1 "D:\\0_PROGRAM\\0_0_0_PROGR_PC\\НОВ_КАБ\\") 
(setq dan2 "D:\\0_PROGRAM\\0_0_0_PROGR_PC\\НОВ_КАБ\\A\\") 
(if (not mas)(progn (textscr)
  (princ "==========================================")(terpri)
  (princ "    МАСШТАБ     1              = 1        ")(terpri)
  (princ "    МАСШТАБ   100              = 2        ")(terpri)
  (princ "    МАСШТАБ   РАЗНЫЙ           = 3        ")(terpri)
  (princ "------------------------------------------")(terpri)
  (setq mas (getstring "\nВВЕДИТЕ МАСШТАБ ЧЕРТЕЖА\n:"))
))

Установка начальных данных – определение пути нахождения текстовых файлов и своего местонахождения. Одновременно принимаем решение о масштабе чертежа установки таблицы пожарной сигнализации. Это необходимо, если принято решение поместить таблицу ПС в чертеж расположения планов объекта, а не отдельный чертеж.

(command "_setvar" "attreq" "0")
(if (not net)(progn (textscr)
  (princ "==========================================")(terpri)
  (princ "    1 ЭТАЖ                          = 1   ")(terpri)
  (princ "    2 ЭТАЖ                          = 2   ")(terpri)
  (princ "    N ЭТАЖА ДРУГОЙ ВВЕСТИ НОМЕР     = N   ")(terpri)
  (princ "------------------------------------------")(terpri)
  (setq net (getstring "\nВВЕДИТЕ N ЭТАЖА\n:"))
))

Ввод данных по номеру этажа. Смысл этого номера совсем не конкретный этаж. Это может быть и номер этажа, или номер пожарного отсека, или номер сектора здания, т.е. номер укрупненного «куска», имеющего самостоятельное значение.

(setq cikl t)
(setq blk (strcat dan1 "tb1_dpls"))
(setq pt (getpoint"\n ВВЕДИТЕ ТОЧКУ вставки строки ТАБЛИЦЫ ПC\n: "))
(if (equal mas "1")(progn (command "_insert" blk pt "1" "1" "0")))
(if (equal mas "2")(progn 
    (command "_insert" blk pt "100" "100" "0")))
(if (equal mas "3")(progn
    (setq mas1 (getstring "\nВВЕДИТЕ МАСШТАБ ЧЕРТЕЖА\n:"))
    (command "_insert" blk pt mas1 mas1 "0")))
(setq blk (strcat dan1 "tb2_dpls"))(setq nnn 1)
  (princ "============================================")(terpri)
  (princ "  НАЧАЛЬНЫЙ НОМЕР ШЛЕЙФА ДЛЯ ТАБЛИЦЫ   = 2  ")(terpri)
  (princ "--------------------------------------------")(terpri)
  (setq nsh (getstring "\nВЫБЕРИТЕ НОМЕР ШЛЕЙФА\n:"))

Формируем дополнительные данные:

определение начального блока названия таблицы ПС,
определение первой точки вставки таблицы ПС,
вставка начального блока названия таблицы ПС (зависимость от масштаба),
определение блока-строки таблицы ПС,
выбор номера начального шлейфа, с которого начинается построение таблицы ПС (позволяет создавать таблицу ПС частями при больших объемах работы – много этажей или большие площади здания…)

(while cikl
  (if (equal mas "1")(progn 
      (command "_insert" blk pt "1" "1" "0")
      (setq pt (list (car pt)(- (cadr pt) 7)))(gc)))
  (if (equal mas "2")(progn 
      (command "_insert" blk pt "100" "100" "0")
      (setq pt (list (car pt)(- (cadr pt) 700)))(gc)))
  (if (equal mas "3")(progn 
      (command "_insert" blk pt mas1 mas1 "0")
      (setq pt (list (car pt)(- (cadr pt) (* (itoa mas1) 7))))(gc)
  ))
  (load "1_pz_1")(1_pz_1)(setq 1_pz_1 nil)(gc)
  (setq luch (strcat net "-" nsh))
  (setq pr (open (strcat dan2 net "_" nsh ".txt") "r"))
  (setq a (entlast))(princ "pr = ")(princ pr)(terpri)
  (if (not pr) (progn (command "_erase" a "")
      (setq pt (list (car pt)(+ (cadr pt) 7)))))

Начало цикла установки строк таблицы ПС ( в зависимости от масштаба), при этом изменение точки вставки для следующей строки. Запуск задачи "1_pz_1". Она помогает присвоить каждому атрибуту нового установленного блока строки таблицы ПС, соответствующие метки, которые позволят быстро найти нужный атрибут для вставки в него информации.Далее формируется образ названия луча, который будет автоматически последовательно изменяться, для использования в программе – сравнение с названием очередного найденного текстового файла, содержащего данные шлейфа. Этот процесс повторяется после установки информации в строку таблицы ПС, т.е. устанавливается новая строка и используется следующий текстовый файл и т.д. Команда (setq a (entlast)) – позволяет найти последний установленный блок, т.е. новую установленную строку таблицу ПС. И последнее выражение. Если не находится текстовый файл шлейфа (например в случае отсутствия при окончании списка файлов), то установленная строка таблицы ПС просто стирается. А точка вставки меняется на предыдущую.

(if pr (progn 
     (setq datd (read-line pr))
     ;(princ "ТИП ДИП = ")(princ datd)(terpri)
     (if datd   (progn (setq kl (read-line pr))));число ДИП
     (if kl   (progn (setq nnd (read-line pr))))
      ;(princ "ПЕРВЫЙ НОМЕР ДИП    = ")(princ nnd)(terpri)
     (if nnd  (progn (setq npd (read-line pr))))
      ;ПОСЛЕДНИЙ НОМЕР ДИП
     (if npd  (progn (setq nna (read-line pr)))) 
      ;(princ "ПЕРВЫЙ НОМЕР АДРЕСА = ")(princ nna)(terpri)
     (if nna  (progn (setq npa (read-line pr))))
      ;ПОСЛЕДНИЙ НОМЕР АДРЕСА
     (if npa  (progn (setq opr1 (read-line pr))))
      ;(princ "ТИП ИПР             = ")(princ opr1)(terpri)
     (if opr1  (progn (setq opr2 (read-line pr)))) 
       (princ "ЧИСЛО ИПР           = ")(princ opr2)(terpri)
     (if opr2  (progn (setq opr3 (read-line pr))))
       (princ "ПЕРВЫЙ НОМЕР ИПР    = ")(princ opr3)(terpri)
     (if opr3 (progn 
       (setq datr opr1)(setq kl1 opr2)(setq nnd1 opr3)
       (setq opr1 nil opr2 nil opr3 nil)
       (if nnd1 (progn (setq npd1 (read-line pr))))
        ;ПОСЛЕДНИЙ НОМЕР ИПР
       (if npd1 (progn (setq nna1 (read-line pr))))
        ;(princ "1 АДРЕС ИПР = ")(princ nna1)(terpri)
       (if nna1 (progn (setq npa1 (read-line pr))))
        ;ПОСЛЕДНИЙ АДРЕС ИПР
     ))
     (if (and opr2 (not opr3))(progn 
         (setq nuk1 opr1 opr1 nil)))
         ;добавить еще одну величину маловероятно
     (if (not opr2) (progn (setq nuk1 opr1 opr1 nil)))
         ;(if npa  (progn (setq datr (read-line pr))))
         ;(princ "datr = ")(princ datr)(terpri)
     (if (not nuk1)(progn (setq nuk1 (read-line pr))));ЧИСЛО УК-П
     (if nuk1 (progn (setq nbrz (read-line pr))))     ;ЧИСЛО БРИЗ
     (princ "нашел в файле nuk1 = ")(princ nuk1)(terpri)
     (princ "нашел в файле nbrz = ")(princ nbrz)(terpri)
     (if pr (progn (close pr)(setq pr nil)(gc)))
     (princ "1 = ")(terpri)
     (if npa (progn (setq npa (substr npa 9))
         (setq nadi (strcat nna "-" npa))))
     (if npa1 (progn (setq npa1 (substr npa1 9))
         (setq nari (strcat nna1 "-" npa1))))
     (load "1_pz_2")(1_pz_2)(setq 1_pz_2 nil)(gc)
     (setq nnd nil npd nil nna nil npa nil)
     (setq npd1 nil nna1 nil npa1 nil)(gc) 
     (setq kl nil kl1 nil datd nil datr nil nuk1 nil nbrz nil)(gc) 
  ))

Это выражение работает в случае нахождения текстового файла очередного шлейфа на диске. Последовательно считываются данные файла строка за строкой (если есть предыдущая строка, то считывается последующая и т.д.). Эти данные заносятся в переменные, которые расписаны по тексту программы. Нет смысла их перечислять. После формирования списка адреса через тире, запускается задача "1_pz_2", которая позволяет занести в атрибуты строки таблицы ПС данные, считанные из текстового файла.

(setq nnn (+ nnn 1))
  (setq nsh1 (atoi nsh))(setq nsh1 (+ nsh1 1))
  (setq nsh (itoa nsh1))
  (if (> nnn 261)(progn (setq cikl nil)(gc)))
  (if pr (progn (close pr)(setq pr nil)))
) ; конец работы цикла

В этом выражении показана работа цифрового счетчика «nnn» и последовательное изменение номера шлейфа. Необходимо обратить внимание на число «261». Это предел максимального количества шлейфов, при достижении которого программа прекращает свою работу. Понятно, что этот предел можно сделать переменной величиной и вставить о нем запрос вначале программы. Это позволит сэкономить время затраченное программой. Ведь в каждом объекте свое количество шлейфов. При окончании работы программы цикл заканчивает свою работу.

(if pr (progn (close pr)(setq pr nil)))
(setq dan1 nil mas nil mas1 nil cikl nil blk nil pt nil)(gc) 
(setq nnn nil net nil blk nil nsh nil nsh1 nil luch nil a nil)(gc) 
(princ "================ 1_dvg ОКОНЧАНИЕ =============")(terpri)
); окончание работы программы

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

Текст программы 1_DVG.LSP

(defun 1_dvg();установка данных с плана в таблицу
;пож.сигнализации КДЛ
(princ "================ 1_dvg НАЧАЛО ================")(terpri)
(setq dan1 "D:\\0_PROGRAM\\0_0_0_PROGR_PC\\НОВ_КАБ\\") 
(setq dan2 "D:\\0_PROGRAM\\0_0_0_PROGR_PC\\НОВ_КАБ\\A\\") 
(if (not mas)(progn (textscr)
  (princ "==========================================")(terpri)
  (princ "    МАСШТАБ     1              = 1        ")(terpri)
  (princ "    МАСШТАБ   100              = 2        ")(terpri)
  (princ "    МАСШТАБ   РАЗНЫЙ           = 3        ")(terpri)
  (princ "------------------------------------------")(terpri)
  (setq mas (getstring "\nВВЕДИТЕ МАСШТАБ ЧЕРТЕЖА\n:"))
))
(command "_setvar" "attreq" "0")
(if (not net)(progn (textscr)
  (princ "==========================================")(terpri)
  (princ "    1 ЭТАЖ                          = 1   ")(terpri)
  (princ "    2 ЭТАЖ                          = 2   ")(terpri)
  (princ "    N ЭТАЖА ДРУГОЙ ВВЕСТИ НОМЕР     = N   ")(terpri)
  (princ "------------------------------------------")(terpri)
  (setq net (getstring "\nВВЕДИТЕ N ЭТАЖА\n:"))
))	       
(setq cikl t)
(setq blk (strcat dan1 "tb1_dpls"))
(setq pt (getpoint"\n ВВЕДИТЕ ТОЧКУ вставки строки ТАБЛИЦЫ ПC\n: "))
(if (equal mas "1")(progn (command "_insert" blk pt "1" "1" "0")))
(if (equal mas "2")(progn 
    (command "_insert" blk pt "100" "100" "0")))
(if (equal mas "3")(progn
    (setq mas1 (getstring "\nВВЕДИТЕ МАСШТАБ ЧЕРТЕЖА\n:"))
    (command "_insert" blk pt mas1 mas1 "0")))
(setq blk (strcat dan1 "tb2_dpls"))(setq nnn 1)
  (princ "============================================")(terpri)
  (princ "  НАЧАЛЬНЫЙ НОМЕР ШЛЕЙФА ДЛЯ ТАБЛИЦЫ   = 2  ")(terpri)
  (princ "--------------------------------------------")(terpri)
  (setq nsh (getstring "\nВЫБЕРИТЕ НОМЕР ШЛЕЙФА\n:"))
 (while cikl                                         ;3 -
  (if (equal mas "1")(progn 
      (command "_insert" blk pt "1" "1" "0")
      (setq pt (list (car pt)(- (cadr pt) 7)))(gc)))
  (if (equal mas "2")(progn 
      (command "_insert" blk pt "100" "100" "0")
      (setq pt (list (car pt)(- (cadr pt) 700)))(gc)))
  (if (equal mas "3")(progn 
      (command "_insert" blk pt mas1 mas1 "0")
      (setq pt (list (car pt)(- (cadr pt) (* (itoa mas1) 7))))(gc)
  ))
  (load "1_pz_1")(1_pz_1)(setq 1_pz_1 nil)(gc)
  (setq luch (strcat net "-" nsh))
  (setq pr (open (strcat dan2 net "_" nsh ".txt") "r"))
  (setq a (entlast))(princ "pr = ")(princ pr)(terpri)
  (if (not pr) (progn (command "_erase" a "")
      (setq pt (list (car pt)(+ (cadr pt) 7)))))
  (if pr (progn 
     (setq datd (read-line pr))
     ;(princ "ТИП ДИП = ")(princ datd)(terpri)
     (if datd   (progn (setq kl (read-line pr))));число ДИП
     (if kl   (progn (setq nnd (read-line pr))))
      ;(princ "ПЕРВЫЙ НОМЕР ДИП    = ")(princ nnd)(terpri)
     (if nnd  (progn (setq npd (read-line pr))))
      ;ПОСЛЕДНИЙ НОМЕР ДИП
     (if npd  (progn (setq nna (read-line pr)))) 
      ;(princ "ПЕРВЫЙ НОМЕР АДРЕСА = ")(princ nna)(terpri)
     (if nna  (progn (setq npa (read-line pr))))
      ;ПОСЛЕДНИЙ НОМЕР АДРЕСА
     (if npa  (progn (setq opr1 (read-line pr))))
      ;(princ "ТИП ИПР             = ")(princ opr1)(terpri)
     (if opr1  (progn (setq opr2 (read-line pr)))) 
       (princ "ЧИСЛО ИПР           = ")(princ opr2)(terpri)
     (if opr2  (progn (setq opr3 (read-line pr))))
       (princ "ПЕРВЫЙ НОМЕР ИПР    = ")(princ opr3)(terpri)
     (if opr3 (progn 
       (setq datr opr1)(setq kl1 opr2)(setq nnd1 opr3)
       (setq opr1 nil opr2 nil opr3 nil)
       (if nnd1 (progn (setq npd1 (read-line pr))))
        ;ПОСЛЕДНИЙ НОМЕР ИПР
       (if npd1 (progn (setq nna1 (read-line pr))))
        ;(princ "1 АДРЕС ИПР = ")(princ nna1)(terpri)
       (if nna1 (progn (setq npa1 (read-line pr))))
        ;ПОСЛЕДНИЙ АДРЕС ИПР
     ))
     (if (and opr2 (not opr3))(progn 
         (setq nuk1 opr1 opr1 nil)))
         ;добавить еще одну величину маловероятно
     (if (not opr2) (progn (setq nuk1 opr1 opr1 nil)))
         ;(if npa  (progn (setq datr (read-line pr))))
         ;(princ "datr = ")(princ datr)(terpri)
     (if (not nuk1)(progn (setq nuk1 (read-line pr))));ЧИСЛО УК-П
     (if nuk1 (progn (setq nbrz (read-line pr))))     ;ЧИСЛО БРИЗ
     (princ "нашел в файле nuk1 = ")(princ nuk1)(terpri)
     (princ "нашел в файле nbrz = ")(princ nbrz)(terpri)
     (if pr (progn (close pr)(setq pr nil)(gc)))
     (princ "1 = ")(terpri)
     (if npa (progn (setq npa (substr npa 9))
         (setq nadi (strcat nna "-" npa))))
     (if npa1 (progn (setq npa1 (substr npa1 9))
         (setq nari (strcat nna1 "-" npa1))))
     (load "1_pz_2")(1_pz_2)(setq 1_pz_2 nil)(gc)
     (setq nnd nil npd nil nna nil npa nil)
     (setq npd1 nil nna1 nil npa1 nil)(gc) 
     (setq kl nil kl1 nil datd nil datr nil nuk1 nil nbrz nil)(gc) 
  )) 
  (setq nnn (+ nnn 1))
  (setq nsh1 (atoi nsh))(setq nsh1 (+ nsh1 1))
  (setq nsh (itoa nsh1))
  (if (> nnn 261)(progn (setq cikl nil)(gc)))
  (if pr (progn (close pr)(setq pr nil)))
)                                                                      (if pr (progn (close pr)(setq pr nil)))
(setq dan1 nil mas nil mas1 nil cikl nil blk nil pt nil)(gc) 
(setq nnn nil net nil blk nil nsh nil nsh1 nil luch nil a nil)(gc) 
(princ "================ 1_dvg ОКОНЧАНИЕ =============")(terpri)
)

Вспомогательные программы, учавствующие в работе основной программы установки таблицы пожарной сигнализации

Программа присвоения меток атрибутам строки таблицы ПС для их быстрого нахождения

(defun 1_pz_1() 
(princ "=========== 1_PZ_1 НАЧАЛО =================")(terpri)
;определение атрибутов строки шлейфа таблицы пожарной сигнализации
(setq a (entlast))(setq b (cdr(assoc '0 (entget a))))

Эта программа работает, если перед ней была установлена новая строка таблицы ПС. Работа программы начинается с просмотра всех примитивов блока – только что установленной строки таб-лицы ПС. Этому помогает команда (setq a (entlast)) – вызов последнего установленного примитива

(while b (princ "b = ")(princ b)(terpri)
  (if (equal b "ATTRIB") (progn 
      (setq c (cdr(assoc '1 (entget a))))
      (setq d (cdr(assoc '2 (entget a))))
      (setq met (cdr(assoc '5 (entget a))))

Начало работы цикла – просмотр атрибутов блока - строки таблицы ПС, определение в полученном атрибуте значения, имени и метки.

(if (equal d "NL")(progn (setq nlu met)))        ;N луча
      (if (equal d "ET")(progn (setq etg met)))        ;этаж 
      (if (equal d "DLINA")(progn (setq dls met)))     ;длина кабеля 
      (if (equal d "SECHKAB") (progn (setq skb met)))  ;сеч.кабеля
      (if (equal d "MRKAB") (progn (setq mrk met)))    ;марка кабеля
      (if (equal d "NOMADDI") (progn (setq nad met)))  ;N адрес ДИП
      (if (equal d "DIP") (progn (setq chd met)))      ;число ДИП  
      (if (equal d "NOMADRI") (progn (setq nar met)))  ;N ИПР 
      (if (equal d "IPR") (progn (setq chr1 met)))     ;число ИПР
      (if (equal d "BRZ") (progn (setq brz met)))      ;число БРИЗ
      (if (equal d "UKP") (progn (setq ukp met)))      ;число УК-П
      (if (equal d "DAT1") (progn (setq dat1 met)))    ;тип ДИП
      (if (equal d "DAT2") (progn (setq dat2 met)))    ;тип ИПР

Если найденный атрибут блока соответствует одному из указанных условий (по имени), то метка атрибута присваивается одной из переменных, согласно тексту программы. По метке атрибута можно быстро найти этот атрибут.

  ))
  (setq a (entnext a))
  (if a (progn 
      (setq b (cdr(assoc '0 (entget a))))
      (setq c (cdr(assoc '1 (entget a))))
      (setq d (cdr(assoc '2 (entget a))))
      (if (equal b "SEQEND")(progn (setq a nil b nil)))
  ))

После прохождения фильтра условий нахождения атрибута, выражение (setq a (entnext a)) помогает определить следующий примитив блока, т.е. найти следующий атрибут. Цикл работает до тех пор пока на определится конец блока по выражению

(if (equal b "SEQEND")(progn (setq a nil b nil)))

(if (not a) (progn (setq b nil)))
)
(setq a nil b nil c nil bb nil npr nil)
(princ "=========== 1_PZ_1 КОНЕЦ ===============")(terpri)
)

Окончание работы цикла, уничтожение ненужных переменных и выход из задачи

Текст программы 1_PZ_1.LSP

(defun 1_pz_1() 
(princ "=========== 1_PZ_1 НАЧАЛО =================")(terpri)
;определение атрибутов строки шлейфа таблицы пожарной сигнализации
(setq a (entlast))(setq b (cdr(assoc '0 (entget a))))
(while b (princ "b = ")(princ b)(terpri)
  (if (equal b "ATTRIB") (progn 
      (setq c (cdr(assoc '1 (entget a))))
      (setq d (cdr(assoc '2 (entget a))))
      (setq met (cdr(assoc '5 (entget a))))
      (if (equal d "NL")(progn (setq nlu met)))        ;N луча
      (if (equal d "ET")(progn (setq etg met)))        ;этаж 
      (if (equal d "DLINA")(progn (setq dls met)))     ;длина кабеля 
      (if (equal d "SECHKAB") (progn (setq skb met)))  ;сеч.кабеля
      (if (equal d "MRKAB") (progn (setq mrk met)))    ;марка кабеля
      (if (equal d "NOMADDI") (progn (setq nad met)))  ;N адрес ДИП
      (if (equal d "DIP") (progn (setq chd met)))      ;число ДИП  
      (if (equal d "NOMADRI") (progn (setq nar met)))  ;N ИПР 
      (if (equal d "IPR") (progn (setq chr1 met)))     ;число ИПР
      (if (equal d "BRZ") (progn (setq brz met)))      ;число БРИЗ
      (if (equal d "UKP") (progn (setq ukp met)))      ;число УК-П
      (if (equal d "DAT1") (progn (setq dat1 met)))    ;тип ДИП
      (if (equal d "DAT2") (progn (setq dat2 met)))    ;тип ИПР
      (terpri)
  ))
  (setq a (entnext a))
  (if a (progn 
      (setq b (cdr(assoc '0 (entget a))))
      (setq c (cdr(assoc '1 (entget a))))
      (setq d (cdr(assoc '2 (entget a))))
      (if (equal b "SEQEND")(progn (setq a nil b nil)))
  ))
(if (not a) (progn (setq b nil)))
)
(setq a nil b nil c nil bb nil npr nil)
(princ "=========== 1_PZ_1 КОНЕЦ ===============")(terpri)
)

Программа установки данных в строку таблицы ПС

(defun 1_pz_2() ;УСТАНОВКА данных строки шлейфа ПС при вставке
(princ "============= 1_PZ_2 НАЧАЛО ================")(terpri)

Эта программа работает, если перед ней была установлена новая строка таблицы ПС. Начало программы по установке данных в атрибуты строки. Поскольку выражения применяемые в программе очень похожи, рассмотрим только несколько из них.

(if nlu (progn (setq a (handent nlu))
        (setq b (cdr(assoc '0 (entget a))))
        (setq d (cdr(assoc '2 (entget a))))
        (if (equal d "NL")(progn (textscr)(terpri); N луча
            (if luch (progn 
(setq bb (subst (cons 1 luch)(assoc '1 (entget a))(entget a)))
                (entmod bb)(entupd a)))
        ))
))(setq a nil b nil c nil bb nil nlu nil)(gc)(princ)

Ввод информации в ячейку номера луча. По метке атрибута номера луча получаем прямой доступ к атрибуту. При этом используем стандартные формы проверки имени атрибута. Информацию, содержащуюся в переменной LUCH устанавливаем в атрибут

(if dls (progn (setq a (handent dls))
        (setq b (cdr(assoc '0 (entget a))))
        (setq d (cdr(assoc '2 (entget a))))
        (terpri)(princ "ЛУЧ - ШЛЕЙФ =")(princ luch)(terpri)  
        (setq dlss (getstring "ВВЕДИТЕ ДЛИНУ ЛУЧА - ШЛЕЙФА"))
        (if (equal d "DLINA")(progn (textscr)(terpri) ;длина кабеля
            (if dlss (progn 
(setq bb (subst (cons 1 dlss)(assoc '1 (entget a)) (entget a)))
                (entmod bb)(entupd a)))
        ))
))
(princ "УК-П")(princ nuk1)(terpri)
(setq a nil b nil c nil bb nil dls nil dlss nil)(gc)(princ)

Длина шлейфа. Очень похожая часть программы на предыдущую с единственным отличием – имеется запрос длины луча для ввода с клавиатуры по ранее выполненным расчетам

Остальные части программы аналогично условию выбора номера луча (часть 2)

(setq a nil b nil c nil bb nil brz nil brzz nil)(gc)(princ)
(setq datd nil datr nil luch nil)(gc)(princ)
(princ "============= 1_PZ_2 КОНЕЦ ============")(terpri)
)

Окончание работы программы. Уничтожение переменных и очистка памяти

Текст программы 1_PZ_2.LSP

(defun 1_pz_2() ;УСТАНОВКА данных строки шлейфа ПС при вставке
(princ "============= 1_PZ_2 НАЧАЛО ================")(terpri)
(if nlu (progn (setq a (handent nlu))
        (setq b (cdr(assoc '0 (entget a))))
        (setq d (cdr(assoc '2 (entget a))))
        (if (equal d "NL")(progn (textscr)(terpri); N луча
            (if luch (progn 
(setq bb (subst (cons 1 luch)(assoc '1 (entget a))(entget a)))
                (entmod bb)(entupd a)))
        ))
))(setq a nil b nil c nil bb nil nlu nil)(gc)(princ)
(if etg (progn (setq a (handent etg))
        (setq b (cdr(assoc '0 (entget a))))
        (setq d (cdr(assoc '2 (entget a))))
        (if (equal d "ET")(progn (textscr)(terpri); N этажа
            (if net (progn 
(setq bb (subst (cons 1 net)(assoc '1 (entget a)) (entget a)))
                (entmod bb)(entupd a)))
        ))
))(setq a nil b nil c nil bb nil etg nil)(gc)(princ)
(if nad (progn (setq a (handent nad))
        (setq b (cdr(assoc '0 (entget a))))
        (setq d (cdr(assoc '2 (entget a))))
        (if (equal d "NOMADDI")(progn (textscr)(terpri);N адреса ДИП
            (if nadi (progn 
(setq bb (subst (cons 1 nadi)(assoc '1 (entget a)) (entget a)))
                (entmod bb)(entupd a)))
        ))
))(setq a nil b nil c nil bb nil nadi nil nad nil)(gc)(princ)
(if chd (progn (setq a (handent chd))
        (setq b (cdr(assoc '0 (entget a))))
        (setq d (cdr(assoc '2 (entget a))))
        (if (equal d "DIP")(progn (textscr)(terpri);Число ДИП
            (if kl (progn 
(setq bb (subst (cons 1 kl)(assoc '1 (entget a)) (entget a)))
                (entmod bb)(entupd a)))
        ))
))(setq a nil b nil c nil bb nil kl nil chd nil)(gc)(princ)
(if nar (progn (setq a (handent nar))
        (setq b (cdr(assoc '0 (entget a))))
        (setq d (cdr(assoc '2 (entget a))))
        (if (equal d "NOMADRI")(progn (textscr)(terpri);N адреса ИПР
            (if nari (progn 
(setq bb (subst (cons 1 nari)(assoc '1 (entget a)) (entget a)))
                (entmod bb)(entupd a)))
        ))
))(setq a nil b nil c nil bb nil nari nil nar nil)(gc)(princ)
(if chr1 (progn (setq a (handent chr1))
        (setq b (cdr(assoc '0 (entget a))))
        (setq d (cdr(assoc '2 (entget a))))
        (if (equal d "IPR")(progn (textscr)(terpri) ; Число ИПР
            (if kl1 (progn 
(setq bb (subst (cons 1 kl1)(assoc '1 (entget a)) (entget a)))
                (entmod bb)(entupd a)))
        ))
))(setq a nil b nil c nil bb nil kl1 nil chr1 nil)(gc)(princ)
(if dat1 (progn (setq a (handent dat1))
        (setq b (cdr(assoc '0 (entget a))))
        (setq d (cdr(assoc '2 (entget a))))
        (if (equal d "DAT1")(progn (textscr)(terpri); тип ДИП
            (if datd (progn 
(setq bb (subst (cons 1 datd)(assoc '1 (entget a)) (entget a)))
                (entmod bb)(entupd a)))
        ))
))(setq a nil b nil c nil bb nil dat1 nil)(gc)(princ)
(if dat2 (progn (setq a (handent dat2))
        (setq b (cdr(assoc '0 (entget a))))
        (setq d (cdr(assoc '2 (entget a))))
        (if (equal d "DAT2")(progn (textscr)(terpri) ; тип ИПР
            (if datr (progn 
(setq bb (subst (cons 1 datr)(assoc '1 (entget a)) (entget a)))
                (entmod bb)(entupd a)))
        ))
))(setq a nil b nil c nil bb nil dat2 nil)(gc)(princ)
(if (equal datd "ДИП-34А")(progn 
    (setq mrkk "КПСЭнг-FRLS" skbb "1х2х0,75  ")))
(if (equal datd "ДИП-34ПА")(progn 
    (setq mrkk "КПСЭнг-FRLS" skbb "  1х2х0,5  ")))
(if (equal datr "ИПР-513-3А")(progn 
    (setq mrkk "КПСЭнг-FRLS" skbb "1х2х0,75  ")))
(if (and mrk mrkk)(progn (setq a (handent mrk))
    (setq b (cdr(assoc '0 (entget a))))
    (setq d (cdr(assoc '2 (entget a))))
    (if (equal d "MRKAB")(progn (textscr)(terpri) ; марка кабеля
        (if mrkk (progn 
(setq bb (subst (cons 1 mrkk)(assoc '1 (entget a)) (entget a)))
                (entmod bb)(entupd a)))
        ))
))(setq a nil b nil c nil bb nil mrk nil mrkk nil)(gc)(princ)
(if (and skb skbb) (progn (setq a (handent skb))
    (setq b (cdr(assoc '0 (entget a))))
    (setq d (cdr(assoc '2 (entget a))))
    (if (equal d "SECHKAB")(progn (textscr)(terpri) ;сечение кабеля
        (if skbb (progn 
(setq bb (subst (cons 1 skbb)(assoc '1 (entget a)) (entget a)))
                (entmod bb)(entupd a)))
        ))
))(setq a nil b nil c nil bb nil skb nil skbb nil)(gc)(princ)
(if dls (progn (setq a (handent dls))
        (setq b (cdr(assoc '0 (entget a))))
        (setq d (cdr(assoc '2 (entget a))))
        (terpri)(princ "ЛУЧ - ШЛЕЙФ =")(princ luch)(terpri)  
        (setq dlss (getstring "ВВЕДИТЕ ДЛИНУ ЛУЧА - ШЛЕЙФА"))
        (if (equal d "DLINA")(progn (textscr)(terpri) ;длина кабеля
            (if dlss (progn 
(setq bb (subst (cons 1 dlss)(assoc '1 (entget a)) (entget a)))
                (entmod bb)(entupd a)))
        ))
))(princ "УК-П")(princ nuk1)(terpri)
(setq a nil b nil c nil bb nil dls nil dlss nil)(gc)(princ)
(if ukp (progn (setq a (handent ukp))
        (setq b (cdr(assoc '0 (entget a))))
        (setq d (cdr(assoc '2 (entget a))))
        (if (equal d "UKP")(progn (textscr)(terpri) ; число УК-П
            (princ "попал УК-П")(princ nuk1)(terpri)
            (if nuk1 (progn 
(setq bb (subst (cons 1 nuk1)(assoc '1 (entget a)) (entget a)))
                (entmod bb)(entupd a)))
        ))
))(setq a nil b nil c nil bb nil ukp nil ukpp nil)(gc)(princ)
;(if (equal briz "1")(progn
    (if brz (progn (setq a (handent brz))
        (setq b (cdr(assoc '0 (entget a))))
        (setq d (cdr(assoc '2 (entget a))))
        (terpri)(princ "ЛУЧ - ШЛЕЙФ =")(princ luch)(terpri)  
        ;(setq nbrz (getstring "ВВЕДИТЕ ЧИСЛО БРИЗ"))
        (if (equal d "BRZ")(progn (textscr)(terpri) ; число БРИЗ
            (if nbrz (progn 
(setq bb (subst (cons 1 nbrz)(assoc '1 (entget a)) (entget a)))
                (entmod bb)(entupd a)))
        ))
    ))
;))(setq a nil b nil c nil bb nil brz nil brzz nil)(gc)(princ)
(setq datd nil datr nil luch nil)(gc)(princ)
(princ "============= 1_PZ_2 КОНЕЦ ============")(terpri)
)

Чертеж таблицы пожарной сигнализации c дорисовкой шлейфов ДПЛС

Таблица пожарной сигнализации, формируемая программой

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

(defun nachp();головная задача обсчета пож.извещателей адресных
(princ "============ начало nachp ==================")(terpri)

Начало головного модуля

(princ "============================================")(terpri)
(princ "С2000-КДЛ ВЫБОР ПРОЕКТИРОВАНИЯ! С ИПР-513-3А")(terpri)
(princ "--------------------------------------------")(terpri)
(princ " НУМЕРАЦИЯ ИЗВЕЩАТЕЛЕЙ НА ПЛАНЕ ДИП-34А - 1 ")(terpri)
(princ "--------------------------------------------")(terpri)
(princ " ОБСЧЕТ ДАННЫХ ПЛАНА ПОЖ.ИЗВЕЩ.ДИП-34А  - 2 ")(terpri)
(princ "--------------------------------------------")(terpri)
(princ "УСТАНОВКА ТАБЛИЦЫ ПОЖАРНОЙ СИГНАЛИЗАЦИИ - 3 ")(terpri)
(princ "--------------------------------------------")(terpri)
(princ "УСТАНОВКА НОМЕРА ШЛЕЙФА В БРИЗ И УК-П   - 4 ")(terpri)
(princ "============================================")(terpri)
(setq vibp (getstring "\n ВЫБЕРИТЕ ПРОЕКТИРОВАНИЕ\n___:"))(terpri)

Меню выбора исполняемых задач

(if (equal vibp "1")(progn 
    (load "zdp")(zdp)(setq zdp nil)(gc)))
(if (equal vibp "2")(progn 
    (load "1_oppg5")(1_oppg5)(setq 1_oppg5 nil)(gc)))
(if (equal vibp "3")(progn 
    (load "1_dvg")(1_dvg)(setq 1_dvg nil)(gc)))
(if (equal vibp "4")(progn 
    (load "znp")(znp)(setq znp nil)(gc)))

Условия выполнения выбранных задач

(princ "=============== конец nachp ================")(terpri)
)

Окончание головного модуля

Текст головного модуля NACHP.LSP

(defun nachp();головная задача обсчета пож.извещателей адресных
(princ "============ начало nachp ==================")(terpri)
(princ "============================================")(terpri)
(princ "С2000-КДЛ ВЫБОР ПРОЕКТИРОВАНИЯ! С ИПР-513-3А")(terpri)
(princ "--------------------------------------------")(terpri)
(princ " НУМЕРАЦИЯ ИЗВЕЩАТЕЛЕЙ НА ПЛАНЕ ДИП-34А - 1 ")(terpri)
(princ "--------------------------------------------")(terpri)
(princ " ОБСЧЕТ ДАННЫХ ПЛАНА ПОЖ.ИЗВЕЩ.ДИП-34А  - 2 ")(terpri)
(princ "--------------------------------------------")(terpri)
(princ "УСТАНОВКА ТАБЛИЦЫ ПОЖАРНОЙ СИГНАЛИЗАЦИИ - 3 ")(terpri)
(princ "--------------------------------------------")(terpri)
(princ "УСТАНОВКА НОМЕРА ШЛЕЙФА В БРИЗ И УК-П   - 4 ")(terpri)
(princ "============================================")(terpri)
(setq vibp (getstring "\n ВЫБЕРИТЕ ПРОЕКТИРОВАНИЕ\n___:"))(terpri)
(if (equal vibp "1")(progn 
    (load "zdp")(zdp)(setq zdp nil)(gc)))
(if (equal vibp "2")(progn 
    (load "1_oppg5")(1_oppg5)(setq 1_oppg5 nil)(gc)))
 (if (equal vibp "3")(progn 
    (load "1_dvg")(1_dvg)(setq 1_dvg nil)(gc)))
(if (equal vibp "4")(progn 
    (load "znp")(znp)(setq znp nil)(gc)))
(princ "=============== конец nachp ==============")(terpri)
)

Дополнительные возможности – суммарные показатели (обсчет таблицы ПС)

Осталось рассмотреть маленькую задачу обсчета данных таблицы пожарной сигнализации для получения суммарных данных проекта. Для начала рассмотрим содержание строки таблицы пожарной сигнализации:

Имя атрибута	Подсказка атрибута	Значение атрибута
NL	Номер шлейфа (луча)	2-1
ET	Номер этажа	2
DLINA	Длина луча (ДПЛС)	375
SECHKAB	Сечение кабеля	1х2х0,75
MRKAB	Марка кабеля	КПСЭнг-FRLS
DIP	Число дымовых извещателей (ДИП)	63
NOMADDI	Адреса ДИП	А01.045.001-063
IPR	Число ручных извещателей (ИПР)	3
NOMADRI	Адреса ИПР	А01.045.064-066
BRZ	Число блоков БРИЗ	3
UKP	Число коробок УК-П	3
DAT1	Тип ДИП	ДИП-34А
DAT2	Тип ИПР	ИПР-513-3А

Задача суммирования данных таблицы ПС

(defun 1_koll() 
;функция счета суммарных данных таблицы ПС
(setq a (entnext) b t) (terpri)

Начало работы задачи, получение первого примитива чертежа

(while (and a b) 
   (setq b (cdr(assoc '0 (entget a))))
   (if b (progn (setq c (cdr(assoc '2 (entget a))))
         (if (equal b "INSERT")(progn 
             (if (equal c "TBPS2N") (progn (setq aa1 a)))
         ))
           (if (equal b "ATTRIB")(progn

Вхождение в цикл, создание фильтра по выбору блока строки таблицы ПС (в принципе необязательно), создание фильтра по отбору атрибута (обязательно)

             (if (equal c "DLINA")(progn 
                 (setq dl1 (atoi(cdr(assoc '1 (entget a)))))
                 (if (not dlo1) (progn (setq dlo1 0)))
                 (setq dlo1 (+ dlo1 dl1) dl1 nil)
                ))

Создание фильтра по отбору атрибута, содержащего длину шлейфа, если имеется, то длина шлейфа добавляется в переменную общей длины кабеля

             (if (equal c "DIP")(progn 
                 (setq dip1 (atoi(cdr(assoc '1 (entget a)))))
                 (if (not dipo1) (progn (setq dipo1 0)))
                 (setq dipo1 (+ dipo1 dip1) dip1 nil)
                ))

Создание фильтра по отбору атрибута, содержащего количество дымовых пожарных извещателей, если имеется, то количество ДИП добавляется в переменную общего количества ДИП.

Остальные фильтры - ручных ИП, коробок УК-П, устройств БРИЗ работают аналогично, собирая суммарные данные

         ))
   )) 
   (setq a (entnext a))
)

Окончание условий общих фильтров, работа по перелистыванию данных примитива чертежа с помощью выражения (setq a (entnext a)), если переменные a и b прекращают свое существование (например, окончание списка примитивов), заканчивается работа цикла.

(terpri)(terpri)(terpri)(terpri)(terpri)(terpri)(terpri)
(if dlo1 (progn
    (princ "ДЛИНА КАБЕЛЯ КПСЭ 1х2х0,75  (метр) = ")
    (princ dlo1)(princ " м")(terpri)))
(if dipo1 (progn
    (princ "ЧИСЛО ДАТЧИКОВ ДЫМОВЫХ ДИП  (шт)   = ")
    (princ dipo1)(princ " шт")(terpri)))
(if ipro1 (progn
    (princ "ЧИСЛО ДАТЧИКОВ РУЧНЫХ ИПР   (шт)   = ")
    (princ ipro1)(princ " шт")(terpri)))
(if uko1 (progn
    (princ "ЧИСЛО КОРОБОК УК-П          (шт)   = ")
    (princ uko1)(princ " шт")(terpri)))
(if brzo1 (progn
    (princ "ЧИСЛО УСТРОЙСТВ БРИЗ        (шт)   = ")
    (princ brzo1)(princ " шт")(terpri)))

С помощью указанных выражений информация о суммарных данных выносится в текстовое окно Автокада

Текст программы 1_KOLL.LSP

(defun 1_koll() 
;функция счета суммарных данных таблицы ПС
(setq a (entnext) b t) (terpri)
(while (and a b) 
   (setq b (cdr(assoc '0 (entget a))))
   (if b (progn 
         (setq c (cdr(assoc '2 (entget a))))
         (if (equal b "INSERT")(progn 
             (if (equal c "TBPS2N") (progn (setq aa1 a)))
         ))
         (if (equal b "ATTRIB")
             (progn 
             (if (equal c "DLINA")(progn 
                 (setq dl1 (atoi(cdr(assoc '1 (entget a)))))
                 (if (not dlo1) (progn (setq dlo1 0)))
                 (setq dlo1 (+ dlo1 dl1) dl1 nil)
             ))
             (if (equal c "DIP")(progn 
                 (setq dip1 (atoi(cdr(assoc '1 (entget a)))))
                 (if (not dipo1) (progn (setq dipo1 0)))
                 (setq dipo1 (+ dipo1 dip1) dip1 nil)
             ))
             (if (equal c "IPR")(progn 
                 (setq ipr1 (atoi(cdr(assoc '1 (entget a)))))
                 (if (not ipro1) (progn (setq ipro1 0)))
                 (setq ipro1 (+ ipro1 ipr1) ipr1 nil)
             ))
             (if (equal c "UKP")(progn 
                 (setq uk1 (atoi(cdr(assoc '1 (entget a)))))
                 (if (not uko1) (progn (setq uko1 0)))
                 (setq uko1 (+ uko1 uk1) uk1 nil)
             ))
             (if (equal c "BRZ")(progn 
                 (setq brz1 (atoi(cdr(assoc '1 (entget a)))))
                 (if (not brzo1) (progn (setq brzo1 0)))
                 (setq brzo1 (+ brzo1 brz1) brz1 nil)
             ))
         ))
   )) (setq a (entnext a))
)
(terpri)(terpri)(terpri)(terpri)(terpri)(terpri)(terpri)
(if dlo1 (progn
    (princ "ДЛИНА КАБЕЛЯ КПСЭ 1х2х0,75  (метр) = ")
    (princ dlo1)(princ " м")(terpri)))
(if dipo1 (progn
    (princ "ЧИСЛО ДАТЧИКОВ ДЫМОВЫХ ДИП  (шт)   = ")
    (princ dipo1)(princ " шт")(terpri)))
(if ipro1 (progn
    (princ "ЧИСЛО ДАТЧИКОВ РУЧНЫХ ИПР   (шт)   = ")
    (princ ipro1)(princ " шт")(terpri)))
(if uko1 (progn
    (princ "ЧИСЛО КОРОБОК УК-П          (шт)   = ")
    (princ uko1)(princ " шт")(terpri)))
(if brzo1 (progn
    (princ "ЧИСЛО УСТРОЙСТВ БРИЗ        (шт)   = ")
    (princ brzo1)(princ " шт")(terpri)))
(setq a nil b nil c nil a1 nil)(gc)
(setq dlo1 nil dipo1 nil ipro1 nil uko1 nil brzo1 nil)(gc)
)

Данная программа носит упрощенный характер для первичного понимания процесса суммирования. Если таблица пожарной сигнализации носит более сложный характер, т.е содержит большее количество, например дымовых датчиков по типу, задача усложняется. Такие задачи являются предметом будущих пособий – например, автоматизированное построение и обсчет кабельного журнала. В моей практике встречались примеры выполнения кабельного журнала объемом в 37 страниц. Можно представить себе ручной обсчет материала и получение автоматических данных за 5 сек.

Оглавление

						Translate to:
Обратная связь	Новости САПР	Программы	Документация	Полезные советы	Обзорные статьи
Заказ и разработка	Каталог САПР	САПР-конференция	Библиотека ГОСТов	Наши соавторы	Коммерческое ПО