Error in Code - Assistance Needed

[chill3490]

I just tested a free download routine xyscl.lsp from paracadd.com
When I ran it, the folowing error appeared. I need assistance in correcting this.
AutoCAD Error follows:

Enter scale factor 0 to make current scale factors positive. ; error: no
function definition: UKWORD

Here's the routine's code:

;Modify X, Y, and Z scale factors. Each is specified individually allowing unequal scaling (or alternatively setting them equal). (uses UREAL)
;
; AUTHOR: HENRY C. FRANCIS
; 425 N. ASHE ST.
; SOUTHERN PINES, NC 28387
;
; All rights reserved without prejudice.
;
; Copyright: 3-16-95
; Edited: 3-16-95
;
(DEFUN C:XYSCL ( / tht tset tsln cntr tent edtw)
(princ "\nEnter scale factor 0 to make current scale factors positive. ")
(setq keep_sign (ukword 1 "Yes No" "Keep current sign of scale factors? (Yes No)" (if keep_sign keep_sign "Yes")))
(setq xscl (ureal 1 "U" "\nX scale factor or Unchanged" (if xscl xscl 1)))
(setq yscl (ureal 1 "U" "\nY scale factor or Unchanged" xscl))
(setq zscl (ureal 1 "U" "\nZ scale factor or Unchanged" xscl))
(prompt "\nSelect Block: ")
(setq tset (ssget '((0 . "INSERT"))))
(if tset
(progn
(setq tsln (sslength tset))
(setq cntr 0)
)
)
(while
(if (and (< cntr tsln) tset)
(setq tent (entget (ssname tset cntr)))
);if
(progn
(setq edtw (entget (cdar tent)))
(if (eq(cdr(assoc 0 edtw))"INSERT")
(progn
(if (eq xscl "Unchanged")
NIL
(setq edtw
(subst (if(= xscl 0)(cons 41(abs(cdr(assoc 41 edtw))))(cons 41 (if(and(eq keep_sign "Yes")(<(cdr(assoc 41 edtw))0))(* -1 xscl)xscl)))
(assoc 41 edtw)
edtw
)
)
)
(if (eq yscl "Unchanged")
NIL
(setq edtw
(subst (if(= yscl 0)(cons 42(abs(cdr(assoc 42 edtw))))(cons 42 (if(and(eq keep_sign "Yes")(<(cdr(assoc 42 edtw))0))(* -1 yscl)yscl)))
(assoc 42 edtw)
edtw
)
)
)
(if (eq zscl "Unchanged")
NIL
(setq edtw
(subst (if(= zscl 0)(cons 43(abs(cdr(assoc 43 edtw))))(cons 43 (if(and(eq keep_sign "Yes")(<(cdr(assoc 43 edtw))0))(* -1 zscl)zscl)))
(assoc 43 edtw)
edtw
)
)
)
(entmod edtw)
)
)
(setq cntr (1+ cntr))
)
)
(princ)
);DEFUN

Could someone assist in making this routine work?


AutoCAD Mechanical 2004 DX Network License
Dell Precision 380 3.0 Ghz, 1Mb RAM
OS = Win XP Pro

[matt.worland]

You are missing some functions, you need Ukword and ureal to get these to work.

[matt.worland]

Try this, I found those file.

;Modify X, Y, and Z scale factors. Each is specified individually allowing unequal scaling (or alternatively setting them equal). (uses UREAL)
;
; AUTHOR: HENRY C. FRANCIS
; 425 N. ASHE ST.
; SOUTHERN PINES, NC 28387
;
; All rights reserved without prejudice.
;
; Copyright: 3-16-95
; Edited: 3-16-95
;
(defun C:XYSCL (/ tht tset tsln cntr tent edtw)
(princ "\nEnter scale factor 0 to make current scale factors positive. ")
(setq keep_sign (ukword 1
"Yes No"
"Keep current sign of scale factors? (Yes No)"
(if keep_sign
keep_sign
"Yes"
)
)
)
(setq xscl (ureal 1
"U"
"\nX scale factor or Unchanged"
(if xscl
xscl
1
)
)
)
(setq yscl (ureal 1 "U" "\nY scale factor or Unchanged" xscl))
(setq zscl (ureal 1 "U" "\nZ scale factor or Unchanged" xscl))
(prompt "\nSelect Block: ")
(setq tset (ssget '((0 . "INSERT"))))
(if tset
(progn
(setq tsln (sslength tset))
(setq cntr 0)
)
)
(while
(if (and (< cntr tsln) tset)
(setq tent (entget (ssname tset cntr)))
) ;if
(progn
(setq edtw (entget (cdar tent)))
(if (eq (cdr (assoc 0 edtw)) "INSERT")
(progn
(if (eq xscl "Unchanged")
NIL
(setq edtw
(subst (if (= xscl 0)
(cons 41 (abs (cdr (assoc 41 edtw))))
(cons 41
(if (and (eq keep_sign "Yes") (< (cdr (assoc 41 edtw)) 0))
(* -1 xscl)
xscl
)
)
)
(assoc 41 edtw)
edtw
)
)
)
(if (eq yscl "Unchanged")
NIL
(setq edtw
(subst (if (= yscl 0)
(cons 42 (abs (cdr (assoc 42 edtw))))
(cons 42
(if (and (eq keep_sign "Yes") (< (cdr (assoc 42 edtw)) 0))
(* -1 yscl)
yscl
)
)
)
(assoc 42 edtw)
edtw
)
)
)
(if (eq zscl "Unchanged")
NIL
(setq edtw
(subst (if (= zscl 0)
(cons 43 (abs (cdr (assoc 43 edtw))))
(cons 43
(if (and (eq keep_sign "Yes") (< (cdr (assoc 43 edtw)) 0))
(* -1 zscl)
zscl
)
)
)
(assoc 43 edtw)
edtw
)
)
)
(entmod edtw)
)
)
(setq cntr (1+ cntr))
)
)
(princ)
) ;DEFUN

;This function is freeware courtesy of the author's of "Inside AutoLisp" for rel. 10 published by New Riders Publications. This credit must accompany all copies of this function.
;
;* UKWORD User key word. DEF, if any, must match one of the KWD strings
;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as
;* for INITGET. MSG is the prompt string, to which a default string is added
;* as <DEF> (nil or "" for none), and a : is added.
;*
(defun ukword (bit kwd msg def / inp)
(if (and def (/= def ""))
(setq msg (strcat "\n" msg " <" def ">: ")
bit (* 2 (fix (/ bit 2)))
);setq
);if
(initget bit kwd)
(setq inp (getkword msg))
(if inp inp def)
);defun
;*
(princ)
;*


;This function is freeware courtesy of the author's of "Inside AutoLisp" for rel. 10 published by New Riders Publications. This credit must accompany all copies of this function.
;
;* UREAL User interface real function
;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET.
;* MSG is the prompt string, to which a default real is added as <DEF> (nil
;* for none), and a : is added.
;*
(defun ureal (bit kwd msg def / inp)
(if def
(setq msg (strcat "\n" msg " <" (rtos def 2) ">: ")
bit (* 2 (fix (/ bit 2)))
)
(setq msg (strcat "\n" msg ": "))
);if
(initget bit kwd)
(setq inp (getreal msg))
(if inp inp def)
);defun
;*
(princ)
;*