Jump to content

TEXT ASCII

mousho

By mousho
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

mousho Collaborator

mousho

Posted
Posted

Hi friends

i write this lisp and need help to change it

the lisp make a table of character map with /u+0000

there is anyway to use the "alt"+0000 instead?

didnt find enywere the use of "alt" with lisp

text table 2.lsp

mhupp Grand Master

mhupp

Posted
Posted (edited)

Isn't that the same thing?

never mind I see 32 = 2 when its suppose to be space.

 

Creates a txt file in my documents. might help? 

(defun C:ASCII ( / chk out ct code dec oct hex )
  (initget "Yes")
  (setq chk (getkword "\nWriting to ASCII.TXT, continue? <Y>: "))
  (if (or (= chk "Yes")(= chk nil))    (progn
      (setq out (open (strcat (getenv "userprofile") "\\Documents\\ascii.txt") "w") chk 1 code 0 ct 0)
      (princ "\n \n CHAR   DEC  OCT  HEX \n")
      (princ "\n \n CHAR   DEC  OCT  HEX \n" out)
      (while chk
        (setq dec (strcat "  " (itoa code))
          oct (base 8 code) hex (base 16 code))
        (setq dec (substr dec (- (strlen dec) 2) 3))
        (if (< (strlen oct) 3)(setq oct (strcat "0" oct)))
        (princ (strcat "\n " (chr code) "      " dec " "
          oct "  " hex ) )
        (princ (strcat "\n " (chr code) "      " dec " "
          oct "  " hex ) out)
        (cond
          ((= code 255)(setq chk nil))
          ((= ct 20)
            (setq xxx (getstring 
               "\n \nPress 'X' to eXit or any key to continue: "))
            (if (= (strcase xxx) "X")
              (setq chk nil)
              (progn
                (setq ct 0)
                (princ "\n \n CHAR   DEC  OCT  HEX \n")
              )
            )
          )
        )
        (setq ct (1+ ct) code (1+ code))
      )
      (close out)
      (setq out nil)
    )
  )
  (princ)
)

; BASE converts from a decimal integer to a string in another base.
(defun BASE ( bas int / ret yyy zot )
  (defun zot ( i1 i2 / xxx )
    (if (> (setq xxx (rem i2 i1)) 9)
      (chr (+ 55 xxx))
      (itoa xxx)
    )      
  )
  (setq ret (zot bas int) yyy (/ int bas))
  (while (>= yyy bas)
    (setq ret (strcat (zot bas yyy) ret))
    (setq yyy (/ yyy bas))
  )
  (strcat (zot bas yyy) ret)
)
Edited by mhupp
mhupp Grand Master

mhupp

Posted
Posted (edited)

Fixed it with function chr

  

;;----------------------------------------------------------------------------;;
;; used to lookup character ascii number
(defun C:text_table (/ vars vals base i c n H S tx base_n)
  (setq vars '(snapmode osmode cmdecho ATTDIA ATTREQ LUPREC)  ;list of variables
        vals (mapcar 'getvar vars)      ;store old values
  )
  (mapcar 'setvar vars '(0 0 0 0 1 0))  ;set new values
  (setq base (getpoint "\nEnter Starting Point :")
        i 0
        c 0
        n (/ (getvar 'textsize) 8)
        H (getvar 'textsize)
        S (getvar 'textstyle)
  )
  (while (< i 1000)
    (setq tx (strcat (AT:NumFix (itoa i) 4) " = " (chr i))
          base_n (list (+ (car base) (* (fix (* (/ c 25) n)) 100)) (- (cadr base) (* 20 (* c n))))
    )
    (entmake (list '(0 . "TEXT")
                   (cons 8 (getvar 'clayer))
                   (cons 10 base_n)
                   (cons 40 H)
                   (cons 1 tx)
                   (cons 7 S)
             )
    )
    (setq i (1+ i))
    (setq c (1+ c))
    (if (eq c 25)  ;simple counter to step over
      (progn
        (setq base (polar base 0 (* 10 (getvar 'textsize))))
        (setq c 0)
      )
    )
  )
  (mapcar 'setvar vars vals)  ;restore old values
  (princ)
)

(defun AT:NumFix (s n)
 ;; Fix number string with leading zeros
 ;; s - Number string to fix
 ;; n - Number of characters for final string
 ;; Alan J. Thompson, 10.29.09
 ;; (AT:NumFix i 3) i= 1 = 001
  (if (< (strlen s) n)
    (AT:NumFix (strcat "0" s) n)
    s
  )
)
Edited by mhupp
code updated exceed's changes
mousho Collaborator

mousho

Posted
  • Author
Posted
On 6/9/2022 at 4:28 PM, mhupp said:

Fixed it with function chr

  

(defun C:text_table (/ vars vals base i c tx base_n)
  (setq vars '(snapmode osmode cmdecho ATTDIA ATTREQ LUPREC)   ;list of variables
        vals (mapcar 'getvar vars)                             ;store old values
  )
  (mapcar 'setvar vars '(0 0 0 0 1 0))                         ;set new values
  (setq base (getpoint "\nEnter Starting Point :")
        i 0
        c 0
  )
  (while (< i 1000)
    (setq tx (strcat (AT:NumFix (itoa i) 4) " = " (chr i))
          base_n (polar base (* pi 1.5) (* 20 i))
          base_n (list (+ (car base) (* (fix (/ i 25)) 100)) (- (cadr base) (* 20 i)))
    )
    (entmake (list '(0 . "TEXT")
                    (cons 10 base_n)
                    (cons 11 base_n)
                   '(40 . 8.0)
                    (cons 1 tx)
                   '(71 . 0)
                   '(72 . 1)
                   '(70 . 0)
             )
    )
    (setq i (1+ i))
    (setq c (1+ c))
    (if (eq c 25) ;simple counter to step over
      (progn
        (setq base (polar base (* PI 0.5) 500))
        (setq c 0)
      )
    )
  )
  (mapcar 'setvar vars vals)            ;restore old values
  (princ)
)
(defun AT:NumFix (s n)
 ;; Fix number string with leading zeros
 ;; s - Number string to fix
 ;; n - Number of characters for final string
 ;; Alan J. Thompson, 10.29.09
  (if (< (strlen s) n)
    (AT:NumFix (strcat "0" s) n)
    s
  )
)

THX but i get error "Invalid field type 70 in (entmake)."

exceed Proficient

exceed

Posted
Posted
35 minutes ago, mousho said:

THX but i get error "Invalid field type 70 in (entmake)."

 

you can solve that by deleting '(70 . 0) line

I tested it

  

(defun C:text_table (/ vars vals base i c tx base_n)
  (setq vars '(snapmode osmode cmdecho ATTDIA ATTREQ LUPREC)   ;list of variables
        vals (mapcar 'getvar vars)                             ;store old values
  )
  (mapcar 'setvar vars '(0 0 0 0 1 0))                         ;set new values
  (setq base (getpoint "\nEnter Starting Point :")
        i 0
        c 0
  )
  (while (< i 1000)
    (setq tx (strcat (AT:NumFix (itoa i) 4) " = " (chr i))
          base_n (polar base (* pi 1.5) (* 20 i))
          base_n (list (+ (car base) (* (fix (/ i 25)) 100)) (- (cadr base) (* 20 i)))
    )
    (entmake (list '(0 . "TEXT")
                    (cons 10 base_n)
                    (cons 11 base_n)
                   '(40 . 8.0)
                    (cons 1 tx)
                   '(71 . 0)
                   '(72 . 1)
             )
    )
    (setq i (1+ i))
    (setq c (1+ c))
    (if (eq c 25) ;simple counter to step over
      (progn
        (setq base (polar base (* PI 0.5) 500))
        (setq c 0)
      )
    )
  )
  (mapcar 'setvar vars vals)            ;restore old values
  (princ)
)
(defun AT:NumFix (s n)
 ;; Fix number string with leading zeros
 ;; s - Number string to fix
 ;; n - Number of characters for final string
 ;; Alan J. Thompson, 10.29.09
  (if (< (strlen s) n)
    (AT:NumFix (strcat "0" s) n)
    s
  )
)

 

 

  • Like 1
mousho Collaborator

mousho

Posted
  • Author
Posted
1 hour ago, exceed said:

 

you can solve that by deleting '(70 . 0) line

I tested it

  

(defun C:text_table (/ vars vals base i c tx base_n)
  (setq vars '(snapmode osmode cmdecho ATTDIA ATTREQ LUPREC)   ;list of variables
        vals (mapcar 'getvar vars)                             ;store old values
  )
  (mapcar 'setvar vars '(0 0 0 0 1 0))                         ;set new values
  (setq base (getpoint "\nEnter Starting Point :")
        i 0
        c 0
  )
  (while (< i 1000)
    (setq tx (strcat (AT:NumFix (itoa i) 4) " = " (chr i))
          base_n (polar base (* pi 1.5) (* 20 i))
          base_n (list (+ (car base) (* (fix (/ i 25)) 100)) (- (cadr base) (* 20 i)))
    )
    (entmake (list '(0 . "TEXT")
                    (cons 10 base_n)
                    (cons 11 base_n)
                   '(40 . 8.0)
                    (cons 1 tx)
                   '(71 . 0)
                   '(72 . 1)
             )
    )
    (setq i (1+ i))
    (setq c (1+ c))
    (if (eq c 25) ;simple counter to step over
      (progn
        (setq base (polar base (* PI 0.5) 500))
        (setq c 0)
      )
    )
  )
  (mapcar 'setvar vars vals)            ;restore old values
  (princ)
)
(defun AT:NumFix (s n)
 ;; Fix number string with leading zeros
 ;; s - Number string to fix
 ;; n - Number of characters for final string
 ;; Alan J. Thompson, 10.29.09
  (if (< (strlen s) n)
    (AT:NumFix (strcat "0" s) n)
    s
  )
)

 

 

Perfect

how can i change it that it work on the current text style?

exceed Proficient

exceed

Posted
Posted
14 minutes ago, mousho said:

Perfect

how can i change it that it work on the current text style? 

(defun C:text_table (/ vars vals base i c tx base_n currentlayer currenttextstyle currenttextsize somenumber)
  (setq vars '(snapmode osmode cmdecho ATTDIA ATTREQ LUPREC)   ;list of variables
        vals (mapcar 'getvar vars)                             ;store old values
  )
  (mapcar 'setvar vars '(0 0 0 0 1 0))                         ;set new values
  (setq base (getpoint "\nEnter Starting Point :")
        i 0
        c 0
  )

  (setq currentlayer (getvar 'clayer)) ;edited line
  (setq currenttextstyle (getvar 'textstyle)) ;edited line
  (setq currenttextsize (getvar 'textsize)) ;edited line
  (setq somenumber (/ currenttextsize 8))

  (while (< i 1000)
    (setq tx (strcat (AT:NumFix (itoa i) 4) " = " (chr i))
          base_n (polar base (* pi 1.5) (* 20 (* i somenumber)))
          base_n (list (+ (car base) (* (fix (* (/ i 25) somenumber)) 100)) (- (cadr base) (* 20 (* i somenumber))))
    )
    (entmake (list '(0 . "TEXT")
                    (cons 8 currentlayer)
                    (cons 10 base_n)
                    (cons 11 base_n)
                    (cons 40 currenttextsize)
                    (cons 1 tx)
                    (cons 7 currenttextstyle)
                    '(71 . 0)
                    '(72 . 0)
                    '(73 . 2)
                )
    )
    (setq i (1+ i))
    (setq c (1+ c))
    (if (eq c 25) ;simple counter to step over
      (progn
        (setq base (polar base (* PI 0.5) (* 500 somenumber)))
        (setq c 0)
      )
    )
  )
  (mapcar 'setvar vars vals)            ;restore old values
  (princ)
)
(defun AT:NumFix (s n)
 ;; Fix number string with leading zeros
 ;; s - Number string to fix
 ;; n - Number of characters for final string
 ;; Alan J. Thompson, 10.29.09
  (if (< (strlen s) n)
    (AT:NumFix (strcat "0" s) n)
    s
  )
)

 

 

  • Like 1
mousho Collaborator

mousho

Posted
  • Author
Posted
1 hour ago, exceed said: 
(defun C:text_table (/ vars vals base i c tx base_n currentlayer currenttextstyle currenttextsize somenumber)
  (setq vars '(snapmode osmode cmdecho ATTDIA ATTREQ LUPREC)   ;list of variables
        vals (mapcar 'getvar vars)                             ;store old values
  )
  (mapcar 'setvar vars '(0 0 0 0 1 0))                         ;set new values
  (setq base (getpoint "\nEnter Starting Point :")
        i 0
        c 0
  )

  (setq currentlayer (getvar 'clayer)) ;edited line
  (setq currenttextstyle (getvar 'textstyle)) ;edited line
  (setq currenttextsize (getvar 'textsize)) ;edited line
  (setq somenumber (/ currenttextsize 8))

  (while (< i 1000)
    (setq tx (strcat (AT:NumFix (itoa i) 4) " = " (chr i))
          base_n (polar base (* pi 1.5) (* 20 (* i somenumber)))
          base_n (list (+ (car base) (* (fix (* (/ i 25) somenumber)) 100)) (- (cadr base) (* 20 (* i somenumber))))
    )
    (entmake (list '(0 . "TEXT")
                    (cons 8 currentlayer)
                    (cons 10 base_n)
                    (cons 11 base_n)
                    (cons 40 currenttextsize)
                    (cons 1 tx)
                    (cons 7 currenttextstyle)
                    '(71 . 0)
                    '(72 . 0)
                    '(73 . 2)
                )
    )
    (setq i (1+ i))
    (setq c (1+ c))
    (if (eq c 25) ;simple counter to step over
      (progn
        (setq base (polar base (* PI 0.5) (* 500 somenumber)))
        (setq c 0)
      )
    )
  )
  (mapcar 'setvar vars vals)            ;restore old values
  (princ)
)
(defun AT:NumFix (s n)
 ;; Fix number string with leading zeros
 ;; s - Number string to fix
 ;; n - Number of characters for final string
 ;; Alan J. Thompson, 10.29.09
  (if (< (strlen s) n)
    (AT:NumFix (strcat "0" s) n)
    s
  )
)

 

 

Perfect :)

  • Like 1

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...