- <MenuMacro UID="MMU_0054">
- <Macro type="Any">
  <Revision MajorVersion="16" MinorVersion="2" UserVersion="1" />
  <Name xlate="true" UID="XLS_1725">Выпрямление линий по осям</Name>
  <Command>^C^C^P(if (not C:L_ALIGN_XY) (load "l_align_xy")) L_ALIGN_XY</Command>
  <HelpString xlate="true" UID="XLS_1726">Выравнивает линии вертикально или горизонтально</HelpString>
  <SmallImage Name="C:\Program Files\AutoCAD 2006\Support\оформление\l_align_xy.BMP" />
  <LargeImage Name="C:\Program Files\AutoCAD 2006\Support\оформление\l_align_xy.BMP" />
  </Macro>
  </MenuMacro>

      <MenuMacro UID="MMU_0001">
        <Macro type="Any">
          <Revision MajorVersion="16" MinorVersion="2" UserVersion="1" />
          <Name xlate="true" UID="XLS_1703">сварные швы</Name>
          <Command>^C^C_.-vbarun оформление.dvb!Module1.сварные_швы</Command>
          <HelpString xlate="true" UID="XLS_1704">Проставление обозначения сварного шва</HelpString>
          <SmallImage Name="C:\Program Files\AutoCAD 2006\Support\оформление\сварные_швы.bmp" />
          <LargeImage Name="C:\Program Files\AutoCAD 2006\Support\оформление\сварные_швы.bmp" />
        </Macro>
      </MenuMacro>

      <ToolbarRoot>
        <Toolbar ToolbarOrient="floating" ToolbarVisible="show" xval="200" yval="200" rows="1" UID="TBU_0001">
          <Revision MajorVersion="16" MinorVersion="2" UserVersion="1" />
          <Alias>Toolbar1</Alias>
          <Name xlate="true" UID="XLS_0001">Risovanie</Name>
          <ToolbarButton IsSeparator="false" UID="TBBU_0032">
            <Revision MajorVersion="16" MinorVersion="2" UserVersion="1" />
            <Name xlate="true" UID="XLS_1783">сварные швы</Name>
            <MenuItem>
                  <MacroRef MenuMacroID="MMU_0001" />
            </MenuItem>
          </ToolbarButton>

ID_<Author>_<Doing>

ID_SSN_WELD_SEAM_POS

TBBU_SsM_WELD_SEAM_POS

//
//      AutoCAD menu file
//

***MENUGROUP=kpblc-CAD
***TOOLBARS
**KPBLC-CAD_ОБЩИЕ
**TB_KPBLC-CAD_ОБЩИЕ
**TB_CADWARE_ОБЩИЕ
               [_Toolbar("CADWare Общие", _Bottom, _Show, 1, 1, 1)]
ID_CADWARE_WHE_orderup [_Button("Перенос объекта на самый верх", "16_order", "32_order")]^C^C^P(defun c:cadware() (if (not *kpblc-activedoc*) (kpblc-loader)) (kpblc-layer-front nil));cadware;
ID_CADWARE_WHE_TubeMark [_Button("Обозначение трубопровода", "16_tube", "32_tube")]^C^C^P(defun c:cadware() (if (not *kpblc-activedoc*) (kpblc-loader)) (_kpblc-block-insert-tube-mark));cadware;
ID_CADWARE_WHE_TubeCross [_Button("Визуальное перекрестие труб", "16_tubecover", "32_tubecover")]^C^C^P(defun c:cadware() (if (not *kpblc-activedoc*) (kpblc-loader)) (_kpblc-block-insert-tube-cutter));cadware;
            [--]
ID_CADWARE_WHE_UKLON [_Button("Обозначение уклона", "16_gradient", "32_gradient")]^C^C^P(defun c:cadware() (if (not *kpblc-activedoc*) (kpblc-loader)) (kpblc-insert-gradient));cadware;
ID_CADWARE_COMMON_Level [_Button("Отметка", "16_level", "32_level")]^C^C^P(defun c:cadware() (if (not *kpblc-activedoc*) (kpblc-loader)) (kpblc-block-level-insert nil));cadware;
ID_CADWARE_COMMON_LEVEL_PLAN [_Button("Отметка, план", "16_level_plan", "16_level_plan")]^C^C^P(defun c:cadware() (if (not *kpblc-activedoc*) (kpblc-loader)) (kpblc-block-level-insert t));cadware;

**KPBLC-CADC_МАСШТАБЫ
**TB_KPBLC-CADC_МАСШТАБЫ
**TB_CADWARE_МАСШТАБЫ
               [_Toolbar("CADWare Масштабы", _Bottom, _Show, 4, 1, 1)]
ID_CADWARE_SCALE_1 [_Button("1:1", "16_SC_1_001", "ICON_16_BLANK")]^C^C^P(defun c:cadware() (if (not *kpblc-activedoc*) (kpblc-loader)) (_kpblc-scale-set 1) (princ));cadware;
ID_CADWARE_SCALE_5 [_Button("1:5", "16_SC_1_005", "ICON_16_BLANK")]^C^C^P(defun c:cadware() (if (not *kpblc-activedoc*) (kpblc-loader)) (_kpblc-scale-set 5) (princ));cadware;
ID_CADWARE_SCALE_10 [_Button("1:10", "16_SC_1_010", "ICON_16_BLANK")]^C^C^P(defun c:cadware() (if (not *kpblc-activedoc*) (kpblc-loader)) (_kpblc-scale-set 10) (princ));cadware;
ID_CADWARE_SCALE_25 [_Button("1:25", "16_SC_1_025", "ICON_16_BLANK")]^C^C^P(defun c:cadware() (if (not *kpblc-activedoc*) (kpblc-loader)) (_kpblc-scale-set 25) (princ));cadware;
ID_CADWARE_SCALE_50 [_Button("1:50", "16_sc_1_050", "ICON_16_BLANK")]^C^C^P(defun c:cadware() (if (not *kpblc-activedoc*) (kpblc-loader)) (_kpblc-scale-set 50) (princ));cadware;
ID_CADWARE_SCALE_100 [_Button("1:100", "16_sc_1_100", "ICON_16_BLANK")]^C^C^P(defun c:cadware() (if (not *kpblc-activedoc*) (kpblc-loader)) (_kpblc-scale-set 100) (princ));cadware;
ID_CADWARE_SCALE_200 [_Button("1:200", "16_sc_1_200", "ICON_16_BLANK")]^C^C^P(defun c:cadware() (if (not *kpblc-activedoc*) (kpblc-loader)) (_kpblc-scale-set 200) (princ));cadware;

      <MenuMacro UID="ID_CADWARE_SCALE_100">
        <Macro type="Any">
          <Revision MajorVersion="16" MinorVersion="2" UserVersion="1" />
          <Name xlate="true" UID="XLS_0025">1:100</Name>
          <Command>^C^C^P(defun c:cadware() (if (not *kpblc-activedoc*) (kpblc-loader)) (_kpblc-scale-set 100) (princ));cadware; </Command>
          <SmallImage Name="16_sc_1_100" />
          <LargeImage Name="ICON_16_BLANK" />
        </Macro>
      </MenuMacro>

          <ToolbarButton IsSeparator="false" UID="TBBU_0013">
            <Revision MajorVersion="16" MinorVersion="2" UserVersion="1" />
            <Name xlate="true" UID="XLS_0026">1:100</Name>
            <MenuItem>
              <MacroRef MenuMacroID="ID_CADWARE_SCALE_100" />
            </MenuItem>
          </ToolbarButton>

(defun c:full-purge (/
                     ax:purge-block
                     ax:purge-layer
                     ax:purge-all-layers
                     ax:purge-layers
                     ax:purge-no-echo
                     deletelayerfilters
                     deletelayerfilters2
                     deletelayerstates
                     lmankill
                     deleteallpagesetups
                     purgeanonymgroups
                     purgeallgroups
                     delacad_vba
                     purgeappid
                     )

  (vl-load-com)

;;; PURGER.LSP
;;;
;;; Various purge functions with no command line echo
;;;
;;; By Jimmy Bergmark
;;; Copyright (C) 1997-2004 JTB World, All Rights Reserved
;;; Website: www.jtbworld.com
;;; E-mail: info@jtbworld.com
;;; 2000-02-12 - First release
;;; 2003-01-09 - More added
;;; 2004-05-23 - Added support to delete filters in 2005
;;; Written for AutoCAD 2000, 2000i, 2002, 2004, 2005
;;;

;;; Purge named block
;;; Example: (ax:purge-block (vla-get-activedocument (vlax-get-acad-object))
;;; "testblock")
;;; Argument: doc {document}
;;;           name {a block name}
;;; Return values: T if successful, nil if not successful
  (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)
                    );_ end of vl-catch-all-apply
                  );_ end of list
            );_ end of vl-catch-all-apply
          );_ end of vl-catch-all-error-p
      nil; name cannot be purged or doesn't exist
      t; name purged
      );_ end of if
    );_ end of defun

;;; Purge named layer
;;; Example: (ax:purge-layer (vla-get-activedocument (vlax-get-acad-object))
;;; "testlayer")
;;; Argument: doc {document}
;;;           name {a layer name}
;;; Return values: T if successful, nil if not successful
  (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)
                    );_ end of vl-catch-all-apply
                  );_ end of list
            );_ end of vl-catch-all-apply
          );_ end of vl-catch-all-error-p
      nil; name cannot be purged or doesn't exist
      t; name purged
      );_ end of if
    );_ end of defun

;;; Purge all layers
;;; Example: (ax:purge-all-layers (vla-get-activedocument
;;; (vlax-get-acad-object)))
;;; Argument: doc {document}
  (defun ax:purge-all-layers (doc)
    (vlax-for item (vla-get-layers doc)
      (purge-layer (vla-get-name item))
      );_ end of vlax-for
    );_ end of defun

;;; Purge all layers except those in list
;;; Example: (ax:purge-layers (vla-get-activedocument (vlax-get-acad-object))
;;; '("DIM"
;;; "LAYER1"))
;;; Argument: doc {document}
;;;           name {a layer name list}
  (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)
        );_ end of if
      );_ end of vlax-for
    );_ end of defun

;;; Purge all with no echo to command window
;;; Example: (ax:purge-no-echo (vla-get-activedocument
;;; (vlax-get-acad-object)))
;;; Argument: doc {document}
  (defun ax:purge-no-echo (doc / getkeys getdictname massoc)

;;; Returns a list of keynames from the specified dictionary
    (defun getkeys (dictname / tmp)
      (if (setq tmp (dictsearch (namedobjdict) dictname))
        (massoc 3 tmp)
        );_ end of if
      );_ end of defun

;;; Retrieves the entity name of the specified dictionary
    (defun getdictname (dictname)
      (if (setq tmp (dictsearch (namedobjdict) dictname))
        (cdr (assoc -1 tmp))
        );_ end of if
      );_ end of defun

;;; 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))
          );_ end of if
        );_ end of foreach
      (reverse nlist)
      );_ end of defun

    (vlax-for item (vla-get-blocks doc)
      (vl-catch-all-apply 'vla-delete (list item))
      );_ end of vlax-for
    (vlax-for item (vla-get-dimstyles doc)
      (vl-catch-all-apply 'vla-delete (list item))
      );_ end of vlax-for
    (vlax-for item (vla-get-linetypes doc)
      (vl-catch-all-apply 'vla-delete (list item))
      );_ end of vlax-for
    (vlax-for item (vla-get-plotconfigurations doc)
      (vl-catch-all-apply 'vla-delete (list item))
      );_ end of vlax-for
    ; 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))
        );_ end of if
      );_ end of vlax-for
    ; 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))
        );_ end of if
      );_ end of vlax-for
    (setq li (getkeys "ACAD_MLINESTYLE"))
    (setq len (length li))
    ; one style has to be left
    (foreach na (cdr li)
      (delrecord "ACAD_MLINESTYLE" na)
      );_ end of foreach
    (setq li (getkeys "ACAD_MLINESTYLE"))
    (setq len (length li))
    (if (> len 1)
      (delrecord "ACAD_MLINESTYLE" (car li))
      );_ end of if
    (vlax-for item (vla-get-layers doc)
      (vl-catch-all-apply 'vla-delete 'item)
      );_ end of vlax-for
    nil
    );_ end of defun

;;; Purge/delete all layer filter or filters
;;; Example: (DeleteLayerFilters)
  (defun deletelayerfilters ()
    (vl-catch-all-apply
      '(lambda ()
         (vla-remove
           (vla-getextensiondictionary
             (vla-get-layers
               (vla-get-activedocument (vlax-get-acad-object))
               );_ end of vla-Get-Layers
             );_ end of vla-GetExtensionDictionary
           "ACAD_LAYERFILTERS"
           );_ end of vla-Remove
         );_ end of lambda
      );_ end of vl-Catch-All-Apply
    (princ)
    );_ end of defun

;;; Purge/delete all layer filter or filters compatible with 2005 or later
;;; Example: (DeleteLayerFilters2)
  (defun deletelayerfilters2 ()
    (vl-catch-all-apply
      '(lambda ()
         (vla-remove
           (vla-getextensiondictionary
             (vla-get-layers
               (vla-get-activedocument (vlax-get-acad-object))
               );_ end of vla-Get-Layers
             );_ end of vla-GetExtensionDictionary
           "AcLyDictionary"
           );_ end of vla-Remove
         );_ end of lambda
      );_ end of vl-Catch-All-Apply
    (princ)
    );_ end of defun

;;; Purge/delete all layer states
;;; Example: (DeleteLayerStates)
  (defun deletelayerstates ()
    (vl-catch-all-apply
      '(lambda ()
         (vla-remove
           (vla-getextensiondictionary
             (vla-get-layers
               (vla-get-activedocument
                 (vlax-get-acad-object)
                 );_ end of vla-Get-ActiveDocument
               );_ end of vla-Get-Layers
             );_ end of vla-GetExtensionDictionary
           "ACAD_LAYERSTATES"
           );_ end of vla-Remove
         );_ end of lambda
      );_ end of vl-Catch-All-Apply
    (princ)
    );_ end of defun

;;; Purge/delete all Express Tool layer states
;;; Example: (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))
          );_ end of progn
        );_ end of if
      );_ end of while
    (princ)
    );_ end of defun

;;; (deleteAllPageSetups)
  (defun deleteallpagesetups (/ pc)
    (vlax-for pc (vla-get-plotconfigurations
                   (vla-get-activedocument (vlax-get-acad-object))
                   );_ end of vla-get-plotconfigurations
      (vla-delete pc)
      );_ end of vlax-for
    );_ end of defun

  (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)))
            );_ end of if
          );_ end of progn
        );_ end of if
      (setq index (+ 1 index))
      );_ end of while
    (princ)
    );_ end of defun

  (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)))
        );_ end of if
      (setq index (+ 1 index))
      );_ end of while
    (princ)
    );_ end of defun

  (defun delacad_vba ()
    (dictremove (namedobjdict) "ACAD_VBA")
    (princ)
    );_ end of defun

    ; Purges all RegApp or RegApp's.

  (defun purgeappid (/ appid)
    (vl-load-com)
    (vlax-for appid (vla-get-registeredapplications
                      (vla-get-activedocument
                        (vlax-get-acad-object)
                        );_ end of vla-get-activedocument
                      );_ end of vla-get-registeredapplications
      (vl-catch-all-apply 'vla-delete (list appid))
      );_ end of vlax-for
    (princ)
    );_ end of defun

;; Последовательность можно менять, а также добавлять или сносить ненужное.
;; Лично я пользуюсь этими частями
  (delacad_vba)
  (lmankill)
  (deletelayerstates)
;; Следующие 2 строки очень давно заменены на программу от vk по удалению фильтров слоев
;; но найти ее сейчас я не могу.
  (deletelayerfilters)
  (deletelayerfilters2)
  (repeat 3 (vla-purgeall (vla-get-activedocument (vlax-get-acad-object))))

  );_ end of defun