Тема: LISP. Подсчет и сортировка блоков с записью информации в файл
Программа составлена в предположении, что в одном файле находятся несколько планов этажей, поэтому выбор объектов производится с помощью рамки (скажем, в пределах одного этажа). Информация записывается в текстовый файл в той же папке, в которой находится текущий рисунок DWG.
;*******list_blk.lsp *********************************
; Подсчет и сортировка блоков на текущем слое.
; Автор Владимир Громов.
;
(defun C:LIST_BLK
( / echo lay zag inf tn tk fil fl ss1 ss ssn1 pp pp1 n spo spisok
ssn e eo ko spt sp1 sp2 )
(setq echo (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq lay (getvar "CLAYER"))
(setq zag (strcat "\n ПОДСЧЕТ И СОРТИРОВКА БЛОКОВ НА СЛОЕ " "'" lay "'" ".\n"))
(setq inf (getstring T "\n Информация (объект, этаж, помещение и др.): "))
(princ "\n Выбор объектов.")
(setq tn (getpoint " Первый угол рамки: "))
(setq tk (getcorner tn "\n Второй угол рамки: "))
(setq fil (strcat (getvar "DWGPREFIX") (vl-filename-base (getvar "DWGNAME")) "_blk.txt"))
(if (not (findfile fil))
(progn
(setq fl (open fil "w"))
(princ zag fl)
(close fl)
))
(princ "\n\nСОРТИРОВКА И ВЫБОРКА.\n")
(princ inf)(princ "\n")
(setq ss1 (ssget "_W" tn tk))
(if ss1
(progn
(setq ss (ssadd)) ;Пустой набор
(setq ssn1 (sslength ss1) n 0) ;Количество примитивов
(repeat ssn1
(setq pp (ssname ss1 n)) ;Имена примитивов
(setq pp1 (entget pp)) ;Данные примитива с именем pp
(cond
((and (= (cdr (assoc 8 pp1)) lay) (= (cdr (assoc 0 pp1)) "INSERT")) (ssadd
pp ss) ;Набор БЛОКОВ
))
(setq n (+ n 1))
)
(if ss
(progn
(setq spo nil spisok nil)
(setq fl (open fil "a"))
(princ "\n" fl)
(princ inf fl)
(princ "\n -----------------------------------------------" fl)
(close fl)
(princ "\nОбщий список блоков: \n")
(setq ssn (sslength ss) n 0)
(repeat ssn
(setq e (ssname ss n))
(setq eo (cdr (assoc 2 (entget e))))
(princ eo)
(princ " ")
(setq spo (cons eo spo))
(setq n (+ n 1))
)
))
(setq spo (acad_strlsort spo))
(princ "\n")
(princ spo)
(setq ko (length spo))
(princ "\n Всего установлено блоков: ")
(princ ko)
(princ "\n")
(setq fl (open fil "a"))
(princ "\n Всего установлено блоков: " fl)
(princ ko fl)
(princ "\n" fl)
(close fl)
(setq n 0 k 0 spt nil)
(if ko
(progn
(princ "\n Количество блоков типа: ")
(setq fl (open fil "a"))
(princ "\n Количество блоков типа: " fl)
(close fl)
(while spo
(setq k 0 spisok nil)
(setq spt spo)
(setq sp1 (nth k spt))
(repeat ko
(setq sp2 (nth k spt))
(if (= sp2 sp1)
(progn
(setq spisok (cons sp2 spisok))
(setq spo (vl-remove sp2 spo))
))
(setq k (+ k 1))
)
(princ "\n ")
(princ sp1) (princ " - ")
(princ (length spisok))
(setq fl (open fil "a"))
(princ "\n " fl)
(princ sp1 fl)
(cond
((= (strlen sp1) 1) (princ " - " fl))
((= (strlen sp1) 2) (princ " - " fl))
((= (strlen sp1) 3) (princ " - " fl))
((= (strlen sp1) 4) (princ " - " fl))
((= (strlen sp1) 5) (princ " - " fl))
((> (strlen sp1) 5) (princ " - " fl))
)
(princ (length spisok) fl)
(close fl)
(if (= spt nil) (setq ko nil))
)
(setq fl (open fil "a"))
(princ "\n" fl)
(close fl)
))
(princ "\n Информация записана в файл: ") (princ fil)
)
(progn
(princ "\n Нет выбранных блоков!")
(alert "\n Нет выбранных блоков!")
(princ)
)
)
(princ "\n ВЫБОРКА ЗАКОНЧЕНА.")
(setvar "CMDECHO" echo)
(princ)
)Возможный макрос для кнопки или пункта меню:
^C^C^P(if (not C:LIST_BLK) (load "list_blk")) LIST_BLK
