Solved: Scale List cleanup lisp

htls69 · ‎05-20-2015

can someone help me with this error

...; error: bad argument type: numberp: "1:60"

;; Utilities to clean-up scale lists

;; Command to remove all XREF scale lists
(defun c:ScaleListRemXRef (/)
  (princ
    (strcat "\n"
	    (itoa (DelScaleListMatch "*XREF*" (GetScaleListEntities)))
	    " XREF scales deleted."
    ) ;_ end of strcat
  ) ;_ end of princ
  (princ)
) ;_ end of defun

;; Command to remove all Imperial scales
(defun c:ScaleListRemImperial (/)
  (princ
    (strcat "\n"
	    (itoa (DelScaleListMatch "*=*" (GetScaleListEntities)))
	    " Imperial scales deleted."
    ) ;_ end of strcat
  ) ;_ end of princ
  (princ)
) ;_ end of defun

;; Command to remove all Metric Scales
(defun c:ScaleListRemMetric (/)
  (princ
    (strcat "\n"
	    (itoa (DelScaleListMatch "*:*" (GetScaleListEntities)))
	    " Metric scales deleted."
    ) ;_ end of strcat
  ) ;_ end of princ
  (princ)
) ;_ end of defun

;; Command to ensure Imperial scales are present
(defun c:ScaleListImperial (/)
  (princ (strcat "\n" (itoa (InstallScaleList StdImplScaleList)) " scales added"))
  (princ)
) ;_ end of defun

;; Command to ensure ISO scales are present
(defun c:ScaleListMetric (/)
  (princ (strcat "\n" (itoa (InstallScaleList StdISOScaleList)) " scales added"))
  (princ)
) ;_ end of defun

;; Command to remove incorrect scales & ensure standard scales
;; in relation to the MEASUREMENT sysvar
(defun c:ScaleListStandard (/)
  (princ "\nRemoving XREF scales ...")
  (c:ScaleListRemXRef);Remove XREF scales
  (if (= 0 (getvar "MEASUREMENT"))
    (progn
      (prompt "\nRemoving Metric scales ...")
      (c:ScaleListRemMetric)
      (prompt "\nInstalling Standard Imperial scales ...")
      (c:ScaleListImperial)
    )
    (progn
      (prompt "\nRemoving Imperial scales ...")
      (c:ScaleListRemImperial)
      (prompt "\nInstalling Standard Metric scales ...")
      (c:ScaleListMetric)
    )
  )
  (princ)
)


;; ----------------------------------
;; Utility functions                 
;; ----------------------------------

;; List of standard Imperial scales as per AutoCAD
(setq StdImplScaleList
       '(("1:1" 1.0 . 1.0)			;Scale type A
	 ("1\" = 5'\"" "1:60")			;Scale type B
	 ("1\" = 10'\"" "1:120")		;Scale type C
	 ("1\" = 20'\"" "1:240")		;Scale type D
	 ("1\" = 30'\"" "1:360")		;Scale type E
	 ("1\" = 40'\"" "1:480")		;Scale type F
	 ("1\" = 50'\"" "1:600")		;Scale type G
	 ("1\" = 60'\"" "1:720")		;Scale type H
	 ("1\" = 80'\"" "1:960")		;Scale type I
	 ("1\" = 100'\"" "1:1200")		;Scale type J
	 ("1\" = 200'\"" "1:2400")		;Scale type K
	 ("1\" = 300'\"" "1:3600")		;Scale type L
	 ("1\" = 400'\"" "1:4800")		;Scale type M
	 ("1\" = 500'\"" "1:6000")		;Scale type N
	 ("1\" = 600'\"" "1:7200")		;Scale type O
	 ("1\" = 1000'\"" "1:12000")	;Scale type P
	 ("1\" = 2000'\"" "1:24000")	;Scale type Q
	 ("1\" = 3000'\"" "1:36000")	;Scale type R
	 ("1\" = 4000'\"" "1:48000")	;Scale type S
	 ("1\" = 5000'\"" "1:60000")	;Scale type T
	 ("1\" = 6000'\"" "1:72000")	;Scale type U
	)
) ;_ end of setq

;; List of standard ISO scales (from ISO 13567)
(setq StdISOScaleList
       '(("1:1" 1.0 . 1.0)		;Scale type A
	 ("1:10" 1.0 . 10.0)		;Scale type B
	 ("1:20" 1.0 . 20.0)		;Scale type C
	 ("1:30" 1.0 . 30.0)		;Scale type D
	 ("1:40" 1.0 . 40.0)		;Scale type E
	 ("1:50" 1.0 . 50.0)		;Scale type F
	 ("1:60" 1.0 . 60.0)		;Scale type G
	 ("1:80" 1.0 . 80.0)		;Scale type H
	 ("1:100" 1.0 . 100.0)		;Scale type I
	 ("1:200" 1.0 . 200.0)		;Scale type J
	 ("1:300" 1.0 . 300.0)		;Scale type K
	 ("1:400" 1.0 . 400.0)		;Scale type L
	 ("1:500" 1.0 . 500.0)		;Scale type M
	 ("1:600" 1.0 . 600.0)		;Scale type N
	 ("1:1000" 1.0 . 1000.0)	;Scale type O
	 ("1:2000" 1.0 . 2000.0)	;Scale type P
	 ("1:3000" 1.0 . 3000.0)	;Scale type Q
	 ("1:4000" 1.0 . 4000.0)	;Scale type R
	 ("1:5000" 1.0 . 5000.0)	;Scale type S
	 ("1:6000" 1.0 . 6000.0)	;Scale type T
	)
) ;_ end of setq

;; Function to obtain list of scale entity names
(defun GetScaleListEntities (/ lst item)
  (setq lst nil)
  (foreach item	(dictsearch (namedobjdict) "ACAD_SCALELIST")
    (if	(= 350 (car item))
      (setq lst (cons (cdr item) lst))
    ) ;_ end of if
  ) ;_ end of foreach
  lst
) ;_ end of defun

;; Function to obtain list of scale types in current drawing
(defun GetScaleList (/ lst lst1 item data)
  (setq	lst  (GetScaleListEntities)
	lst1 nil
  ) ;_ end of setq
  (foreach item	lst
    (setq data (entget item))
    (setq lst1 (cons (vl-list* (cdr (assoc 300 data))
			       (cdr (assoc 140 data))
			       (cdr (assoc 141 data))
		     ) ;_ end of vl-list*
		     lst1
	       ) ;_ end of cons
    ) ;_ end of setq
  ) ;_ end of foreach

  ;; Sort the list - most detailed to least
  (setq	lst
	 (vl-sort lst1
		  '(lambda (s1 s2)
		     (> (/ (cadr s1) (cddr s1)) (/ (cadr s2) (cddr s2)))
		   ) ;_ end of lambda
	 ) ;_ end of vl-sort
  ) ;_ end of setq
) ;_ end of defun

;; Function to delete scale matching a wildcard name
(defun DelScaleListMatch (pattern lst / item data count)
  (setq count 0)
  (foreach item	lst
    (setq data (entget item))
    (if	(wcmatch (cdr (assoc 300 data)) pattern)
      (progn
	(entdel item)
	(setq count (1+ count))
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of foreach
  count
) ;_ end of defun

;; Function to ensure list of scale are installed
(defun InstallScaleList (stdlst / lst item cmd)
  (setq lst (GetScaleList))		;Get list of scale entity names

  ;; Remove items from stdlst which is already in the drawing
  (setq	stdlst (vl-remove-if
		 '(lambda (e) (/= nil (assoc (car e) lst)))
		 stdlst
	       ) ;_ end of vl-remove-if
  ) ;_ end of setq

  (setq cmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (command "._undo" "_Begin")
  ;; Start scalelist edit if needed
  (if (> (length stdlst) 0)
    (command ".-scalelistedit")
  )
  ;; Step through remainder of stdlst
  (foreach item	stdlst
    (command "_Add" (car item) (strcat (rtos (cadr item)) ":" (rtos (cddr item))))
  ) ;_ end of foreach

  ;; End scalelist edit if needed
  (if (> (length stdlst) 0)
    (command "_Exit")
  )
  (command "._undo" "_End")
  (setvar "CMDECHO" cmd)
  (length stdlst)
)

(princ)
 ;|«Visual LISP© Format Options»
(72 2 40 2 T "end of " 60 9 0 0 0 T T nil T)
;*** DO NOT add text below the comment! ***|;

Allen Robberson
Credit where credit is due! Give kudos or accept as solution whenever you can.

htls69 · ‎05-20-2015

want it to look and be like this when i am done

Allen Robberson
Credit where credit is due! Give kudos or accept as solution whenever you can.

Civil3DReminders_com · ‎05-20-2015

I haven't run the code to try it out, but I think the format should be:

("1\" = 5'\"" 1.0 . 5.0)

instead of using a string value.

Civil Reminders
http://blog.civil3dreminders.com/
http://www.CivilReminders.com/

Alumni

MikeEvansUK · ‎05-21-2015

There is possibly an easier way. I found this when trying to work out how to remove the scales defigned in mm.

The Scales are stored in the registry.

Windows Registry Editor Version 5.00

[HKEY_USERS\S-1-5-21-2599018305-3156215502-2470237774-3769\Software\Autodesk\AutoCAD\R20.0\ACAD-E000:409\Scale List]
" 0.ScaleName"="1\" = 1\""
" 0.ScalePaperUnits"="1.00000000"
" 0.ScaleDrawingUnits"="0.08333333"
" 0.ScaleType"="3"
" 1.ScaleName"="1\" = 5'"
" 1.ScalePaperUnits"="1.00000000"
" 1.ScaleDrawingUnits"="5.00000000"
" 1.ScaleType"="2"

The above is metric but you can reword accordingly. Note it is version specific (R20.0\ACAD-E000:409)

Now when I run scalelistedit reset it defaults as my reg key.

Please don't do this if you are unfamiliar with the registry and before you do do this export a copy of the Key in case you foul it up.

But if you copy the exported key then edit and import it will always work. Much better than trying to do it via lsp.

Mike Evans

Civil3D 2022 English
Windows 7 Professional 64-bit
Intel(R) Core(TM) i7-3820 CPU @ 3.60GHz (8 CPUs), ~4.0GHz With 32768MB RAM, AMD FirePro V4900, Dedicated Memory: 984 MB, Shared Memory: 814 MB

htls69 · ‎05-21-2015

now it works but they all look wierd see the extra inch mark

Allen Robberson
Credit where credit is due! Give kudos or accept as solution whenever you can.

Civil3DReminders_com · ‎05-21-2015

There is an unneeded ' after the numbers you can delete so it shows 5'/" and the ' needs to be removed . I didn't catch that last time.

Civil Reminders
http://blog.civil3dreminders.com/
http://www.CivilReminders.com/

Alumni

htls69 · ‎05-21-2015

still not working

Allen Robberson
Credit where credit is due! Give kudos or accept as solution whenever you can.

tyronebk · ‎05-21-2015

I think you are looking for this format:

("1\" = 5'" 1.0 . 5.0)

Notepad ++ will display strings in grey and numbers in orange. Make sure each line has the same coloring.

htls69 · ‎05-21-2015

THAT WORKED PERFECTLY THANKS

HERE IT IS CORRECTED

;; Utilities to clean-up scale lists

;; Command to remove all XREF scale lists
(defun c:ScaleListRemXRef (/)
  (princ
    (strcat "\n"
	    (itoa (DelScaleListMatch "*XREF*" (GetScaleListEntities)))
	    " XREF scales deleted."
    ) ;_ end of strcat
  ) ;_ end of princ
  (princ)
) ;_ end of defun

;; Command to remove all Imperial scales
(defun c:ScaleListRemImperial (/)
  (princ
    (strcat "\n"
	    (itoa (DelScaleListMatch "*=*" (GetScaleListEntities)))
	    " Imperial scales deleted."
    ) ;_ end of strcat
  ) ;_ end of princ
  (princ)
) ;_ end of defun

;; Command to remove all Metric Scales
(defun c:ScaleListRemMetric (/)
  (princ
    (strcat "\n"
	    (itoa (DelScaleListMatch "*:*" (GetScaleListEntities)))
	    " Metric scales deleted."
    ) ;_ end of strcat
  ) ;_ end of princ
  (princ)
) ;_ end of defun

;; Command to ensure Imperial scales are present
(defun c:ScaleListImperial (/)
  (princ (strcat "\n" (itoa (InstallScaleList StdImplScaleList)) " scales added"))
  (princ)
) ;_ end of defun

;; Command to ensure ISO scales are present
(defun c:ScaleListMetric (/)
  (princ (strcat "\n" (itoa (InstallScaleList StdISOScaleList)) " scales added"))
  (princ)
) ;_ end of defun

;; Command to remove incorrect scales & ensure standard scales
;; in relation to the MEASUREMENT sysvar
(defun c:ScaleListStandard (/)
  (princ "\nRemoving XREF scales ...")
  (c:ScaleListRemXRef);Remove XREF scales
  (if (= 0 (getvar "MEASUREMENT"))
    (progn
      (prompt "\nRemoving Metric scales ...")
      (c:ScaleListRemMetric)
      (prompt "\nInstalling Standard Imperial scales ...")
      (c:ScaleListImperial)
    )
    (progn
      (prompt "\nRemoving Imperial scales ...")
      (c:ScaleListRemImperial)
      (prompt "\nInstalling Standard Metric scales ...")
      (c:ScaleListMetric)
    )
  )
  (princ)
)


;; ----------------------------------
;; Utility functions                 
;; ----------------------------------

;; List of standard Imperial scales as per AutoCAD
(setq StdImplScaleList
       '(("1:1" 1.0 . 1.0)			;Scale type A
	 ("1\" = 5'" 1.0 . 5.0)			;Scale type B
	 ("1\" = 10'" 1.0 . 10.0)		;Scale type C
	 ("1\" = 20'" 1.0 . 20.0)		;Scale type D
	 ("1\" = 30'" 1.0 . 30.0)		;Scale type E
	 ("1\" = 40'" 1.0 . 40.0)		;Scale type F
	 ("1\" = 50'" 1.0 . 50.0)		;Scale type G
	 ("1\" = 60'" 1.0 . 60.0)		;Scale type H
	 ("1\" = 80'" 1.0 . 80.0)		;Scale type I
	 ("1\" = 100'" 1.0 . 100.0)		;Scale type J
	 ("1\" = 200'" 1.0 . 200.0)		;Scale type K
	 ("1\" = 300'" 1.0 . 300.0)		;Scale type L
	 ("1\" = 400'" 1.0 . 400.0)		;Scale type M
	 ("1\" = 500'" 1.0 . 500.0)		;Scale type N
	 ("1\" = 600'" 1.0 . 600.0)		;Scale type O
	 ("1\" = 1000'" 1.0 . 1000.0)	;Scale type P
	 ("1\" = 2000'" 1.0 . 2000.0)	;Scale type Q
	 ("1\" = 3000'" 1.0 . 3000.0)	;Scale type R
	 ("1\" = 4000'" 1.0 . 4000.0)	;Scale type S
	 ("1\" = 5000'" 1.0 . 5000.0)	;Scale type T
	 ("1\" = 6000'" 1.0 . 6000.0)	;Scale type U
	)
) ;_ end of setq

;; List of standard ISO scales (from ISO 13567)
(setq StdISOScaleList
       '(("1:1" 1.0 . 1.0)		;Scale type A
	 ("1:10" 1.0 . 10.0)		;Scale type B
	 ("1:20" 1.0 . 20.0)		;Scale type C
	 ("1:30" 1.0 . 30.0)		;Scale type D
	 ("1:40" 1.0 . 40.0)		;Scale type E
	 ("1:50" 1.0 . 50.0)		;Scale type F
	 ("1:60" 1.0 . 60.0)		;Scale type G
	 ("1:80" 1.0 . 80.0)		;Scale type H
	 ("1:100" 1.0 . 100.0)		;Scale type I
	 ("1:200" 1.0 . 200.0)		;Scale type J
	 ("1:300" 1.0 . 300.0)		;Scale type K
	 ("1:400" 1.0 . 400.0)		;Scale type L
	 ("1:500" 1.0 . 500.0)		;Scale type M
	 ("1:600" 1.0 . 600.0)		;Scale type N
	 ("1:1000" 1.0 . 1000.0)	;Scale type O
	 ("1:2000" 1.0 . 2000.0)	;Scale type P
	 ("1:3000" 1.0 . 3000.0)	;Scale type Q
	 ("1:4000" 1.0 . 4000.0)	;Scale type R
	 ("1:5000" 1.0 . 5000.0)	;Scale type S
	 ("1:6000" 1.0 . 6000.0)	;Scale type T
	)
) ;_ end of setq

;; Function to obtain list of scale entity names
(defun GetScaleListEntities (/ lst item)
  (setq lst nil)
  (foreach item	(dictsearch (namedobjdict) "ACAD_SCALELIST")
    (if	(= 350 (car item))
      (setq lst (cons (cdr item) lst))
    ) ;_ end of if
  ) ;_ end of foreach
  lst
) ;_ end of defun

;; Function to obtain list of scale types in current drawing
(defun GetScaleList (/ lst lst1 item data)
  (setq	lst  (GetScaleListEntities)
	lst1 nil
  ) ;_ end of setq
  (foreach item	lst
    (setq data (entget item))
    (setq lst1 (cons (vl-list* (cdr (assoc 300 data))
			       (cdr (assoc 140 data))
			       (cdr (assoc 141 data))
		     ) ;_ end of vl-list*
		     lst1
	       ) ;_ end of cons
    ) ;_ end of setq
  ) ;_ end of foreach

  ;; Sort the list - most detailed to least
  (setq	lst
	 (vl-sort lst1
		  '(lambda (s1 s2)
		     (> (/ (cadr s1) (cddr s1)) (/ (cadr s2) (cddr s2)))
		   ) ;_ end of lambda
	 ) ;_ end of vl-sort
  ) ;_ end of setq
) ;_ end of defun

;; Function to delete scale matching a wildcard name
(defun DelScaleListMatch (pattern lst / item data count)
  (setq count 0)
  (foreach item	lst
    (setq data (entget item))
    (if	(wcmatch (cdr (assoc 300 data)) pattern)
      (progn
	(entdel item)
	(setq count (1+ count))
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of foreach
  count
) ;_ end of defun

;; Function to ensure list of scale are installed
(defun InstallScaleList (stdlst / lst item cmd)
  (setq lst (GetScaleList))		;Get list of scale entity names

  ;; Remove items from stdlst which is already in the drawing
  (setq	stdlst (vl-remove-if
		 '(lambda (e) (/= nil (assoc (car e) lst)))
		 stdlst
	       ) ;_ end of vl-remove-if
  ) ;_ end of setq

  (setq cmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (command "._undo" "_Begin")
  ;; Start scalelist edit if needed
  (if (> (length stdlst) 0)
    (command ".-scalelistedit")
  )
  ;; Step through remainder of stdlst
  (foreach item	stdlst
    (command "_Add" (car item) (strcat (rtos (cadr item)) ":" (rtos (cddr item))))
  ) ;_ end of foreach

  ;; End scalelist edit if needed
  (if (> (length stdlst) 0)
    (command "_Exit")
  )
  (command "._undo" "_End")
  (setvar "CMDECHO" cmd)
  (length stdlst)
)

(princ)
 ;|«Visual LISP© Format Options»
(72 2 40 2 T "end of " 60 9 0 0 0 T T nil T)
;*** DO NOT add text below the comment! ***|;

Allen Robberson
Credit where credit is due! Give kudos or accept as solution whenever you can.

Scale List cleanup lisp

Scale List cleanup lisp

Forums Links

Post to forums