Translate to: |
|||||||
Обратная связь | Новости САПР | Программы | Документация | Полезные советы | Обзорные статьи | ||
Заказ и разработка | Каталог САПР | САПР-конференция | Библиотека ГОСТов | Наши соавторы | Коммерческое ПО |
;;; PURGER.LSP ;;; ;;; Различные функции очистки без эха в командной строке ;;; ;;; Проверено на AutoCAD 2000, 2000i, 2002, 2004, 2005 ;;; ;;; Очистка именнованного блока ;;; Пример: (ax:purge-block (vla-get-activedocument (vlax-get-acad-object)) "testblock") ;;; Аргументы: doc {документ} ;;; name {имя блока} ;;; возвращаемые значения: T - если успешно, nil - если не успешно (defun ax:purge-block (doc name) (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-delete (list (vl-catch-all-apply 'vla-item (list (vla-get-blocks doc) name) ) ) ) ) nil ; имя не может быть очищено или не существует T ; имя очищено ) ) ;;; Очистка именнованного слоя ;;; Пример: (ax:purge-layer (vla-get-activedocument (vlax-get-acad-object)) "testlayer") ;;; Аргументы: doc {документ} ;;; name {имя слоя} ;;; возвращаемые значения: T - если успешно, nil - если не успешно (defun ax:purge-layer (doc name) (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-delete (list (vl-catch-all-apply 'vla-item (list (vla-get-layers doc) name) ) ) ) ) nil ; имя не может быть очищено или не существует T ; имя очищено ) ) ;;; Очистка всех слоев ;;; Пример: (ax:purge-all-layers (vla-get-activedocument (vlax-get-acad-object))) ;;; Аргументы: doc {документ} (defun ax:purge-all-layers (doc) (vlax-for item (vla-get-layers doc) (purge-layer (vla-get-name item)) ) ) ;;; Очистка всех слоев кроме указанных в списке ;;; Пример: (ax:purge-layers (vla-get-activedocument (vlax-get-acad-object)) '("DIM" "LAYER1")) ;;; Аргумент: doc {документ} ;;; name {список имен слоев} (defun ax:purge-layers (doc except) (vlax-for item (vla-get-layers doc) (setq ln (vla-get-name item)) (if (not (member (strcase ln) except)) (purge-layer ln) ) ) ) ;;; Очистить все без эха в командной строке ;;; \Пример: (ax:purge-no-echo (vla-get-activedocument (vlax-get-acad-object))) ;;; Аргумент: doc {document} (defun ax:purge-no-echo (doc) ;;; Возвращает список ключевых имен из указанного словаря (defun getkeys (dictName / tmp) (if (setq tmp (dictsearch (namedobjdict) dictName)) (massoc 3 tmp) ) ) ;;; Извлекает имя примитива из указанного словаря (defun getdictname (dictName) (if (setq tmp (dictsearch (namedobjdict) dictName)) (cdr (assoc -1 tmp)) ) ) ;;; Utility function to get multiple group code CDRs (defun massoc (key alist / x nlist) (foreach x alist (if (eq key (car x)) (setq nlist (cons (cdr x) nlist)) ) ) (reverse nlist) ) (vlax-for item (vla-get-blocks doc) (vl-catch-all-apply 'vla-delete (list item)) ) (vlax-for item (vla-get-dimstyles doc) (vl-catch-all-apply 'vla-delete (list item)) ) (vlax-for item (vla-get-linetypes doc) (vl-catch-all-apply 'vla-delete (list item)) ) (vlax-for item (vla-get-plotconfigurations doc) (vl-catch-all-apply 'vla-delete (list item)) ) ; textstyles (vlax-for item (vla-get-textstyles doc) (if (= (cdr (assoc 70 (entget (vlax-vla-object->ename item)))) 0) (vl-catch-all-apply 'vla-delete (list item)) ) ) ; shapes (vlax-for item (vla-get-textstyles doc) (if (= (cdr (assoc 70 (entget (vlax-vla-object->ename item)))) 1) (vl-catch-all-apply 'vla-delete (list item)) ) ) (setq li (getkeys "ACAD_MLINESTYLE")) (setq len (length li)) ; one style has to be left (foreach na (cdr li) (delrecord "ACAD_MLINESTYLE" na) ) (setq li (getkeys "ACAD_MLINESTYLE")) (setq len (length li)) (if (> len 1) (delrecord "ACAD_MLINESTYLE" (car li)) ) (vlax-for item (vla-get-layers doc) (vl-catch-all-apply 'vla-delete 'item) ) nil ) ;;; Очистить/Удалить все фильтры слоев или все фильтры, ;;; Пример: (DeleteLayerFilters) (defun DeleteLayerFilters () (vl-Catch-All-Apply '(lambda () (vla-Remove (vla-GetExtensionDictionary (vla-Get-Layers (vla-Get-ActiveDocument (vlax-Get-Acad-Object)) ) ) "ACAD_LAYERFILTERS" ) ) ) (princ) ) ;;; Очистить/Удалить все фильтры слоев или все фильтры, ;;; совместимые с AutoCAD 2005 или более поздним ;;; Пример: (DeleteLayerFilters2) (defun DeleteLayerFilters2 () (vl-Catch-All-Apply '(lambda () (vla-Remove (vla-GetExtensionDictionary (vla-Get-Layers (vla-Get-ActiveDocument (vlax-Get-Acad-Object)) ) ) "AcLyDictionary" ) ) ) (princ) ) ;;; Очистить/Удалить все состояния слоев ;;; Пример: (DeleteLayerStates) (defun DeleteLayerStates () (vl-Catch-All-Apply '(lambda () (vla-Remove (vla-GetExtensionDictionary (vla-Get-Layers (vla-Get-ActiveDocument (vlax-Get-Acad-Object)))) "ACAD_LAYERSTATES"))) (princ) ) ;;; Очистить/Удалить все состояния слоев Express Tool ;;; Пример: (LmanKill) (defun LmanKill (/ lyr ent cnt) (setq cnt 0) (while (setq lyr (tblnext "layer" (not lyr))) (setq ent (entget (tblobjname "layer" (cdr (assoc 2 lyr)))'("RAK"))) (if (and ent (assoc -3 ent)) (progn (setq ent (subst '(-3 ("RAK")) (assoc -3 ent) ent)) (entmod ent) (setq cnt (1+ cnt)) ) ) ) (princ) ) ;;; (deleteAllPageSetups) (defun deleteAllPageSetups (/ pc) (vlax-for pc (vla-get-plotconfigurations (vla-get-activedocument (vlax-get-acad-object))) (vla-delete pc) ) ) (defun PurgeAnonymGroups (/ grpList index grp) (setq grpList (dictsearch (namedobjdict) "ACAD_GROUP")) (setq index 1) (while (setq grp (nth index grplist)) (if (= (car grp) 3) (progn (if (= (chr 42) (substr (cdr grp) 1 1)) (entdel (cdr (nth (+ index 1) grplist))) ) ) ) (setq index (+ 1 index)) ) (princ) ) (defun PurgeAllGroups (/ grpList index grp) (setq grpList (dictsearch (namedobjdict) "ACAD_GROUP")) (setq index 1) (while (setq grp (nth index grplist)) (if (= (car grp) 3) (entdel (cdr (nth (+ index 1) grplist))) ) (setq index (+ 1 index)) ) (princ) ) (defun DelACAD_VBA () (dictremove (namedobjdict) "ACAD_VBA") (princ) ) ; Очистит все RegApp или RegApps. (defun PurgeAPPID (/ appid) (vl-load-com) (vlax-for appid (vla-get-registeredapplications (vla-get-activedocument (vlax-get-acad-object) ) ) (vl-catch-all-apply 'vla-delete (list appid)) ) (princ) )
Copyright © Сайт поддержки пользователей САПР