;;; 11/2007 aus http://ww3.cad.de/foren/ubb/Forum54/HTML/016522.shtml
;;; eingestellt von Heinz Dober
;;; teilweise ins Deutsche übersetzt von Peter Tropf, Karlsruhe (info@petertropf.de)
;;;  Tipp: Der wichtigste Befehl lautet SCALELISTDELALL:
;;;  Er löscht alle unbenutzten Maßstäbe außer 1:1 und impotiert die metrische Maßstabsliste,
;;;  die man am Ende der Datei konfigurieren kann (mit STRG+F nach ***H suchen)
;;; ==========================================================================
;;; File: ScaleListDel.lsp
;;; Purpose: Scale list deletion and management for AutoCAD 2008
;;; Author: Steve Johnson
;;; Date: 13 August 2007
;;; Version: 0.7
;;; Copyright: (c) 2007 cad nauseam (www.cadnauseam.com)
;;; May be distributed and used freely provided this header is retained in full
;;; --------------------------------------------------------------------------
;;; Disclaimer:
;;; This code is supplied as-is and with no warranty whatsoever.
;;; Destruction of annotative objects WILL result from incorrect use.
;;; Use at own risk. No responsibility accepted. Read all notes before use.
;;; --------------------------------------------------------------------------
;;; Commands:
;;;  SCALELISTDEL
;;;  Deletes unused scales except 1:1 using a user-provided wildcard.
;;;  SCALELISTDELALL
;;;  Deletes all unused scales except 1:1.
;;;  SCALELISTDELINCH
;;;  Deletes all unused scales that contain the inch " character.
;;;  SCALELISTDELXREF
;;;  Deletes all unused scales that contain the "_XREF" string.
;;;  SCALELISTDEL_
;;;  Deletes all unused scales that contain the "_" character.
;;;  SCALELISTDELINCHXREF
;;;  Deletes all unused scales that contain either the inch " character or
;;;  the "_XREF" string.
;;;  SCALELISTDELINCH_
;;;  Deletes all unused scales that contain either the inch " or "_"
;;;  characters.
;;;  SCALELISTMETRIC
;;;  Deletes all existing unused scales except 1:1 and sets up metric scales.
;;;  SCALELISTMETRICTEMPLATE
;;;  Deletes all existing scales and sets up metric scales. For use only in
;;;  setting up scales in templates and pre-2008 drawings.
;;;  WARNING: potentially destructive to annotative objects!
;;;  SCALELISTINCH
;;;  Deletes all existing unused scales except 1:1 and sets up inch-based
;;;  scales.
;;;  SCALELISTINCHTEMPLATE
;;;  Deletes all existing scales and sets up inch-based scales. For use
;;;  only in setting up scales in templates and pre-2008 drawings.
;;;  WARNING: potentially destructive to annotative objects!
;;; --------------------------------------------------------------------------
;;; Functions:
;;;  (scaledel_all_unsafe)
;;;  Deletes all scales in the current drawing, including 1:1 and scales in
;;;  use.
;;;  WARNING: potentially destructive to annotative objects!

;;;  (scaledel_wcard_unsafe WCARD-OR-LIST)
;;;  If WCARD-OR-LIST is a wildcard string, deletes scales that match that
;;;  wildcard, excluding 1:1 but including scales in use.
;;;  If WCARD-OR-LIST is a list of scale names, deletes those scales,
;;;  including 1:1 (if listed) and scales in use.
;;;  WARNING: potentially destructive to annotative objects!

;;;  (scaledel_long_xref LONG-SCALE-LIST)
;;;  Cleans up those scales that are too long to delete using the command-line
;;;  (i.e. over 132 characters). These are usually only those created by the
;;;  AutoCAD 2008 pre-SP1 bug that created _XREF_XREF_XREF scales, and this
;;;  is checked before deletion.

;;;  (scaledel_warning)
;;;  Issues a warning and asks user to enter Yes before continuing.

;;;  (scaledel_get_scalelist)
;;;  Returns a list of scales in the drawing.

;;;  (scaledel_all)
;;;  Deletes all scales other than 1:1 and scales in use.

;;;  (scaledel_reset)
;;;  Performs a -SCALELIST Reset command.

;;;  (scaledel_smart_reset)
;;;  Performs a -SCALELIST Reset command if it is likely to reduce the number
;;;  of scales in the list, prior to setting things up.

;;;  (scaledel_wcard WCARD)
;;;  Deletes scales that match WCARD, excluding 1:1 and scales in use.

;;;  (scaledel_create_scales SCALES)
;;;  Creates a set of scales defined in list SCALES.


;;;  (scaledel_create_metric)
;;;  Creates a set of metric scales: see *** in code to adjust list.

;;;  (scaledel_create_inch)
;;;  Creates a set of inch scales: see *** in code to adjust list.
;;; --------------------------------------------------------------------------
;;; Notes:
;;; Other than the SCALELIST*TEMPLATE commands, the commands will not delete
;;; the 1:1 scale, even if it is not in use. This is because if the scale list
;;; is completely cleared, AutoCAD 2008 will automatically recreate it using
;;; its hardwired list when the user picks the "Custom..." item that
;;; remains in the list. Leaving in the 1:1 scale prevents this from happening.
;;; The (scaledel_*_unsafe) functions can be used to delete all scales,
;;; including 1:1 and those in use, if you really need to do so.
;;; --------------------------------------------------------------------------
;;; Later AutoCAD releases:
;;; As AutoCAD 2008's annotative scaling feature needs work, it is quite likely
;;; that future releases of AutoCAD will do things differently. This may result
;;; in this software failing to work correctly, or working with unintended
;;; results. Check carefully before using this software in 2009 and later.
;;; --------------------------------------------------------------------------
;;; WARNING:
;;; Any function that uses the (scaledel_*_unsafe) functions may be DESTRUCTIVE
;;; to any annotative objects in the drawing, because they allow the deletion
;;; of scales that are in use.
;;; ==========================================================================


(if (>= (atof (substr (getvar "ACADVER") 1 4)) 17.1)
  (progn ; Only define these functions if they will work (ie. 2008 or later)


;    (prompt "\nLoading ScaleListDel.lsp Version 0.7... ")
    (prompt "\nScaleListDel.lsp Version 0.7 wird geladen...\n") ; übersetzt von Peter Tropf

;;; --------------------------------------------------------------------------
;;; Commands


    (defun C:SCALELISTDEL (/ wcard)
;      (setq wcard (getstring "\nEnter scale name(s) to delete: "))
      (setq wcard (getstring "\nMaßstäbe eingeben, die gelöscht werden sollen: ")) ; übersetzt von Peter Tropf
      (if (/= wcard "")
        (scaledel_long_xref (scaledel_wcard wcard))
      )
      (princ)
    ) ; End C:SCALELISTDEL


    (defun C:SCALELISTDELALL ()
      (scaledel_all)
      (princ)
    ) ; End C:SCALELISTDELXREF


    (defun C:SCALELISTDELXREF ()
      (scaledel_long_xref (scaledel_wcard "*_XREF"))
      (princ)
    ) ; End C:SCALELISTDELXREF


    (defun C:SCALELISTDEL_ ()
      (scaledel_long_xref (scaledel_wcard "*_*"))
      (princ)
    ) ; End C:SCALELISTDEL_


    (defun C:SCALELISTDELINCH ()
      (scaledel_long_xref (scaledel_wcard "*\"*"))
      (princ)
    ) ; End C:SCALELISTDELINCH


    (defun C:SCALELISTDELINCHXREF ()
      (scaledel_long_xref (scaledel_wcard "*\"*,*_XREF"))
      (princ)
    ) ; End C:SCALELISTDELINCHXREF


    (defun C:SCALELISTDELINCH_ ()
      (scaledel_long_xref (scaledel_wcard "*\"*,*_*"))
      (princ)
    ) ; End C:SCALELISTDELINCHXREF


    (defun C:SCALELISTMETRIC ()
      (scaledel_smart_reset)
;      (prompt "\nDeleting existing unused scales...")
      (prompt "\nNicht benutzte Maßstäbe werden gelöscht...\n") ; übersetzt von Peter Tropf
      (scaledel_long_xref (scaledel_wcard "*"))
;      (prompt "\nCreating metric scales...")
      (prompt "\nMetrische Maßstäbe werden erzeugt...") ; übersetzt von Peter Tropf
      (scaledel_create_metric)
      (princ)
    ) ; End C:SCALELISTMETRIC


    (defun C:SCALELISTMETRICTEMPLATE ()
      (if (= (scaledel_warning) "Yes")
        (progn
          (scaledel_smart_reset)
;          (prompt "\nDeleting all existing scales...")
          (prompt "\nAlle vorhandenen Maßstäbe werden gelöscht...") ; übersetzt von Peter Tropf
          (scaledel_all_unsafe)
;          (prompt "\nCreating metric scales...")
          (prompt "\nMetrische Maßstäbe werden erzeugt...") ; übersetzt von Peter Tropf
          (scaledel_create_metric)
        )
      )
      (princ)
    ) ; End C:SCALELISTMETRICTEMPLATE



    (defun C:SCALELISTINCH ()
      (scaledel_smart_reset)
      (prompt "\nDeleting existing unused scales...")
      (scaledel_wcard "*")
      (prompt "\nCreating inch scales...")
      (scaledel_create_inch)
      (princ)
    ) ; End C:SCALELISTINCH


    (defun C:SCALELISTINCHTEMPLATE ()
      (if (= (scaledel_warning) "Yes")
        (progn
          (scaledel_smart_reset)
          (prompt "\nDeleting all existing scales...")
          (scaledel_all_unsafe)
          (prompt "\nCreating inch scales...")
          (scaledel_create_inch)
        )
      )
      (princ)
    ) ; End C:SCALELISTINCHTEMPLATE


;;; --------------------------------------------------------------------------
;;; Functions


    (defun scaledel_all_unsafe (/ scale-en-list)
      (foreach item (dictsearch (namedobjdict) "ACAD_SCALELIST")
        (if (= 350 (car item))
          (setq scale-en-list (cons (cdr item) scale-en-list))
        )
      )
      (foreach item scale-en-list
        (entdel item)
      )
    ) ; End scaledel_all_unsafe


    (defun scaledel_wcard_unsafe (WCARD-OR-LIST / scale-list scale)
      (foreach item (dictsearch (namedobjdict) "ACAD_SCALELIST")
        (if (= 350 (car item))
          (setq
            scale-list
            (cons
              (cons (strcase (cdr (assoc 300 (entget (cdr item))))) (cdr item))
              scale-list
            )
          )
        )
      )
      (if (= (type WCARD-OR-LIST) 'STR)
        (foreach item scale-list
          (if
            (and
              (wcmatch (car item) (strcase WCARD))
              (/= (car item) "1:1")
            )
            (entdel (cdr item))
          )
        )
        (foreach item WCARD-OR-LIST
          (if (setq scale (assoc (strcase item) scale-list))
            (entdel (cdr scale))
          )
        )
      )
    ) ; End scaledel_wcard_unsafe


    (defun scaledel_long_xref (LONG-SCALE-LIST / scale-list)
      (foreach scale LONG-SCALE-LIST
        (if (wcmatch (strcase scale) "*_XREF_XREF_XREF*")
          (setq scale-list (cons scale scale-list))
        )
      )
      (if scale-list
        (progn
          (prompt "\nDeleting the following long _XREF scale(s):")
          (foreach scale scale-list
            (prompt (strcat "\n " scale))
          )
          (scaledel_wcard_unsafe scale-list)
        )
      )
    ) ; End scaledel_long_xref


    (defun scaledel_warning ()
      (initget "Yes No")
;      (initget "Ja Nein")
      (getkword
        (strcat
          "\nThis command will first destroy all existing scales including those in use."
          "\nAre you sure you want to do this? [Yes/No] <No>: "
;          "\nDieser Befehl wird zuerst ALLE Maßstäbe löschen, auch die benutzten Maßstäbe."
;          "\nSind Sie sicher, dass Sie dies wollen? [Ja/Nein] <Nein>: "
        )
      )
    ) ; End scaledel_warning


    (defun scaledel_get_scalelist (/ scale-list)
      (foreach item (dictsearch (namedobjdict) "ACAD_SCALELIST")
        (if (= 350 (car item))
          (setq
            scale-list
            (cons (strcase (cdr (assoc 300 (entget (cdr item))))) scale-list)
          )
        )
      )
      scale-list
    ) ; End scaledel_get_scalelist


    (defun scaledel_all ()
      (scaledel_smart_reset)
      (scaledel_long_xref (scaledel_wcard "*"))
    ) ; End scaledel_all


    (defun scaledel_reset (/ cmdecho)
      (setq cmdecho (getvar "CMDECHO"))
      (setvar "CMDECHO" 0)
      (command "_.-SCALELISTEDIT" "_R" "_Y" "_E")
      (setvar "CMDECHO" cmdecho)
    ) ; End scaledel_reset


    (defun scaledel_smart_reset ()
      (if (> (length (scaledel_get_scalelist)) 40)
        (scaledel_reset)
      )
    ) ; End scaledel_smart_reset


    (defun scaledel_wcard (WCARD / scale-list cmdecho long-scale-list)
      (foreach scale (scaledel_get_scalelist)
        (if
          (and
            (wcmatch (strcase scale) (strcase WCARD))
            (/= scale "1:1")
          )
          (setq scale-list (cons scale scale-list))
        )
      )
      (if scale-list
        (progn
          (setq cmdecho (getvar "CMDECHO"))
          (setvar "CMDECHO" 0)
          (command "_.-SCALELISTEDIT")
          (foreach item scale-list
            (if (<= (strlen item) 132)
              (command "_D" item) ; Attempt to delete scale
              (setq long-scale-list (cons item long-scale-list))
            )
          )
          (command "_E")
          (setvar "CMDECHO" cmdecho)
        )
      )
      long-scale-list ; Returns list of scales too long to delete
    ) ; End scaledel_wcard


    (defun scaledel_create_scales (SCALES / scale-list-all cmdecho)
      (setq
        scale-list-all (scaledel_get_scalelist)
        cmdecho (getvar "CMDECHO")
      )
      (setvar "CMDECHO" 0)
      (command "_.-SCALELISTEDIT")
      (foreach scale SCALES
        (if (not (member (strcase (car scale)) scale-list-all))
          (command "_A" (car scale) (cadr scale))
        )
      )
      (command "_E")
      (setvar "CMDECHO" cmdecho)
    ) ; End scaledel_create_scales


;;; --------------------------------------------------------------------------
;; *** Note: several uncommon scales have been commented out.
;; Delete the leading semi-colon to make a scale active.
;; You can comment out an unwanted scale by placing a semi-colon at
;; the start of its line.

;; ***Hinweis: Mehrere unübliche Maßstäbe wurden auskommentiert.
;; Löschen Sie den Semikolon (;) am Beginn der Zeile, um den betreffenden
;; Maßstab zu aktivieren.
;; Umgekehrt können Sie unerwünschte Maßstäbe durch Voranstellen eines
;; Semikolon (;) auskommentieren.
;; Nach dem gleichen Schema können auch andere Maßstäbe hinzugefügt werden.

    (defun scaledel_create_metric ()
      (scaledel_create_scales
        '(
;          ("10:1" "1:.0001")
;          ("5:1" "1:.0002")
;          ("2:1" "1:.0005")
;          ("1:1" "1:.001")
;          ("1:2" "1:.002")
;          ("1:2.5" "1:2.5")
;          ("1:5" "1:.005")
;          ("1:10" "1:10")
;          ("1:20" "1:.02")
;          ("1:25" "1:.025")
;          ("1:50" "1:.05")
;          ("1:100" "1:.1")
;          ("1:200" "1:.2")
;	  ("1:250" "1:.25")
;          ("1:500" "1:.5")
;          ("1:1000" "1:1")
;          ("1:2000" "1:2000")
;          ("1:2500" "1:2500")
;          ("1:5000" "1:5000")
;          ("1:10000" "1:10000")
;          ("1:20000" "1:20000")
;          ("1:25000" "1:25000")
;          ("1:50000" "1:50000")
;          ("1:100000" "1:100000")
;          ("1:200000" "1:200000")
;          ("1:250000" "1:250000")
;          ("1:500000" "1:500000")
          ("1:1" "1:1")
          ("1:1 Modell" "1000:1")
          ("1:2" "1000:2")
;          ("1:2.5" "1000:2.5")
          ("1:5" "1000:5")
          ("1:10" "1000:10")
          ("1:20" "1000:20")
          ("1:25" "1000:25")
          ("1:50" "1000:50")
          ("1:100" "1000:100")
          ("1:200" "1000:200")
          ("1:250" "1000:250")
          ("1:500" "1000:500")
          ("1:1000" "1000:1000")
;          ("1:2000" "1000:2000")
          ("1:2500" "1000:2500")
          ("1:5000" "1000:5000")
;          ("1:10000" "1000:10000")
;          ("1:20000" "1000:20000")
;          ("1:25000" "1000:25000")
;          ("1:50000" "1000:50000")
;          ("1:100000" "1000:100000")
;          ("1:200000" "1000:200000")
;          ("1:250000" "1000:250000")
;          ("1:500000" "1000:500000")
          ("2:1" "2000:1")
          ("5:1" "5000:1")
        )
      )
    ) ; End scaledel_create_metric


;;; --------------------------------------------------------------------------
;; *** Note: several uncommon scales have been commented out.
;; Delete the leading semi-colon to make a scale active.
;; You can comment out an unwanted scale by placing a semi-colon at
;; the start of its line.

    (defun scaledel_create_inch ()
      (scaledel_create_scales
        '(
;          ("8:1" "8:1")
;          ("4:1" "4:1")
;          ("2:1" "2:1")
          ("1:1" "1:1")
          ("1/32\" = 1'-0\"" "0.03125:12")
          ("1/16\" = 1'-0\"" "0.0625:12")
          ("3/32\" = 1'-0\"" "0.09375:12")
          ("1/8\" = 1'-0\"" "0.125:12")
          ("3/16\" = 1'-0\"" "0.1875:12")
          ("1/4\" = 1'-0\"" "0.25:12")
          ("3/8\" = 1'-0\"" "0.375:12")
          ("1/2\" = 1'-0\"" "0.5:12")
          ("3/4\" = 1'-0\"" "0.75:12")
          ("1\" = 1'-0\"" "1:12")
          ("1-1/2\" = 1'-0\"" "1.5:12")
          ("3\" = 1'-0\"" "3:12")
          ("6\" = 1'-0\"" "6:12")
          ("1\" = 10'-0\"" "1:120")
          ("1\" = 20'-0\"" "1:240")
          ("1\" = 30'-0\"" "1:360")
          ("1\" = 40'-0\"" "1:480")
          ("1\" = 50'-0\"" "1:600")
          ("1\" = 60'-0\"" "1:720")
          ("1\" = 100'-0\"" "1:1200")
;          ("1\" = 250'-0\"" "1:3000")
;          ("1\" = 500'-0\"" "1:6000")
;          ("1\" = 1000'-0\"" "1:12000")
;          ("1\" = 5280'-0\"" "1:63360")
;          ("1\" = 12000'-0\"" "1:144000")
;          ("1\" = 24000'-0\"" "1:288000")
;          ("1\" = 48000'-0\"" "1:576000")
;          ("1\" = 50000'-0\"" "1:600000")
;          ("1\" = 52800'-0\"" "1:633600")
        )
      )
    ) ; End scaledel_create_inch


    (prompt
      (strcat
        "\nDie Befehle SCALELISTDEL SCALELISTDELALL SCALELISTDELINCH SCALELISTDELXREF "
        "SCALELISTDEL_ SCALELISTDELINCHXREF SCALELISTDELINCH_ SCALELISTMETRIC "
        "SCALELISTMETRICTEMPLATE SCALELISTINCH SCALELISTINCHTEMPLATE "
        "sind geladen.\n"
      )
    )


  ) ; End progn to test for AutoCAD release
;  (prompt "\nRequires AutoCAD 2008 or above.")
  (prompt "\nErfordert AutoCAD 2008 oder eine Nachfolge-Version.")
)

(princ)

;;; ==========================================================================
;;; End of file ScaleListDel.lsp
;;; ==========================================================================