How can I make the following program support Chinese input?

[xcn]

(defun ht:chars	(s / l i n c a)
  (setq	l '()
	i 1
	n (strlen s)
  )
  (while (<= i n)
    (setq c (substr s i 1)
	  a (ascii c)
    )
    (if	(and a (> a 127) (< i n))
      (setq l (cons (substr s i 2) l)
	    i (+ i 2)
      )
      (setq l (cons c l)
	    i (1+ i)
      )
    )
  )
  (reverse l)
)
(defun ht:bbox (s hgt wf sty obl / e tb fallback)
  (setq fallback (list (list 0.0 0.0 0.0) (list 0.0 0.0 0.0)))
  (if (or (null s) (= s ""))
    fallback
    (progn
      (setq e (entmakex	(append	(list '(0 . "TEXT")
				      '(100 . "AcDbEntity")
				      '(100 . "AcDbText")
				      '(10 0.0 0.0 0.0)
				      (cons 40 hgt)
				      (cons 1 s)
				      (cons 41 wf)
				      (cons 7 sty)
				      '(72 . 0)
				      '(73 . 0)
				)
				(if obl
				  (list (cons 51 obl))
				  nil
				)
				(list (cons 11 '(0.0 0.0 0.0)))
			)
	      )
      )
      (if e
	(progn
	  (setq tb (textbox (entget e)))
	  (entdel e)
	  (if (and tb (listp tb) (listp (car tb)) (listp (cadr tb)))
	    tb
	    fallback
	  )
	)
	fallback
      )
    )
  )
)
(defun ht:wid (s hgt wf sty obl)
  (car (cadr (ht:bbox s hgt wf sty obl)))
)
(defun ht:layout
       (chars hgt wf sty obl / prefix out result n i x0 x1 totalw)
  (setq	prefix ""
	out '()
  )
  (foreach ch chars
    (setq
      out (cons	(list ch
		      (- (ht:wid (strcat prefix ch) hgt wf sty obl)
			 (ht:wid ch hgt wf sty obl)
		      )
		)
		out
	  )
    )
    (setq prefix (strcat prefix ch))
  )
  (setq	out    (reverse out)
	totalw (ht:wid prefix hgt wf sty obl)
	n      (length out)
	i      0
	result '()
  )
  (while (< i n)
    (setq x0 (cadr (nth i out))
	  x1 (if (< i (1- n))
	       (cadr (nth (1+ i) out))
	       totalw
	     )
    )
    (setq result (cons (list (car (nth i out)) x0 x1) result))
    (setq i (1+ i))
  )
  (reverse result)
)
(defun ht:origin (ed / g72 g73 rot x y cx cy tb mnx mxx mny mxy hgt)
  (setq	g72 (cond ((cdr (assoc 72 ed)))
		  (t 0)
	    )
	g73 (cond ((cdr (assoc 73 ed)))
		  (t 0)
	    )
	rot (cond ((cdr (assoc 50 ed)))
		  (t 0.0)
	    )
	hgt (cdr (assoc 40 ed))
  )
  (if (and (= g72 0) (= g73 0))
    (setq x (car (cdr (assoc 10 ed)))
	  y (cadr (cdr (assoc 10 ed)))
    )
    (setq x (car (cdr (assoc 11 ed)))
	  y (cadr (cdr (assoc 11 ed)))
    )
  )
  (setq	tb  (ht:bbox (cdr (assoc 1 ed))
		     hgt
		     (cdr (assoc 41 ed))
		     (cdr (assoc 7 ed))
		     (cdr (assoc 51 ed))
	    )
	mnx (car (car tb))
	mxx (car (cadr tb))
	mny (cadr (car tb))
	mxy (cadr (cadr tb))
  )
  (setq	cx (cond ((= g72 1) (/ (+ mnx mxx) 2.0))
		 ((= g72 2) mxx)
		 ((= g72 3) 0.0)
		 ((= g72 4) (/ (+ mnx mxx) 2.0))
		 ((= g72 5) mnx)
		 (t mnx)
	   )
	cy (cond ((= g73 1) mny)
		 ((= g73 2) (/ hgt 2.0))
		 ((= g73 3) hgt)
		 (t 0.0)
	   )
  )
  (list	(- x (- (* cx (cos rot)) (* cy (sin rot))))
	(- y (+ (* cx (sin rot)) (* cy (cos rot))))
  )
)
(defun ht:proj (pt base ang)
  (+ (* (- (car pt) (car base)) (cos ang))
     (* (- (cadr pt) (cadr base)) (sin ang))
  )
)
(defun ht:paint	(layout base ang hgt wf lay sty obl from to / out p)
  (setq out '())
  (foreach item	layout
    (if	(and (< (nth 1 item) to) (> (nth 2 item) from))
      (progn (setq p (list (+ (car base) (* (nth 1 item) (cos ang)))
			   (+ (cadr base) (* (nth 1 item) (sin ang)))
			   0.0
		     )
	     )
	     (entmake (append (list '(0 . "TEXT")
				    '(100 . "AcDbEntity")
				    (cons 8 lay)
				    '(100 . "AcDbText")
				    (cons 10 p)
				    (cons 40 hgt)
				    (cons 1 (car item))
				    (cons 50 ang)
				    (cons 41 wf)
				    (cons 7 sty)
				    (cons 62 1)
				    '(72 . 0)
				    '(73 . 0)
			      )
			      (if obl
				(list (cons 51 obl))
				nil
			      )
			      (list (cons 11 p))
		      )
	     )
	     (setq out (cons (entlast) out))
      )
    )
  )
  out
)
(defun ht:clear	(lst)
  (if (listp lst)
    (foreach e lst
      (if (entget e)
	(entdel e)
      )
    )
  )
)
(defun ht:run (sel     /       hEnt    ed      txt     hgt     wf
	       sty     lay     obl     ang     base    anchor-s
	       chars   layout  input   running gr      code    data
	       cur-s   hl-a    hl-b    hl-from hl-to   i       new-lst
	       new-txt echo-last       last-a  last-b
	      )
  (setq	hEnt (car sel)
	ed   (entget hEnt)
  )
  (if (/= "TEXT" (cdr (assoc 0 ed)))
    (princ "\n not a text")
    (progn
      (setq txt	     (cdr (assoc 1 ed))
	    hgt	     (cdr (assoc 40 ed))
	    wf	     (cond ((cdr (assoc 41 ed)))
			   (t 1.0)
		     )
	    sty	     (cond ((cdr (assoc 7 ed)))
			   (t "Standard")
		     )
	    lay	     (cdr (assoc 8 ed))
	    obl	     (cdr (assoc 51 ed))
	    ang	     (cond ((cdr (assoc 50 ed)))
			   (t 0.0)
		     )
	    base     (ht:origin ed)
	    anchor-s (ht:proj (cadr sel) base ang)
	    chars    (ht:chars txt)
	    layout   (ht:layout chars hgt wf sty obl)
      )
      (princ "\n move mouse to change text")
      (setq running T
	    input ""
	    echo-last 0
	    *ht-tmp* '()
	    last-a nil
	    last-b nil
      )
      (while running
	(setq gr   (grread T 13)
	      code (car gr)
	      data (cadr gr)
	)
	(cond
	  ((= code 5)
	   (setq cur-s	 (ht:proj data base ang)
		 hl-from (min anchor-s cur-s)
		 hl-to	 (max anchor-s cur-s)
		 hl-a	 nil
		 hl-b	 nil
		 i	 0
	   )
	   (foreach item layout
	     (if (and (< (nth 1 item) hl-to) (> (nth 2 item) hl-from))
	       (progn (if (null hl-a)
			(setq hl-a i)
		      )
		      (setq hl-b i)
	       )
	     )
	     (setq i (1+ i))
	   )
	   (if (or (/= hl-a last-a) (/= hl-b last-b))
	     (progn (ht:clear *ht-tmp*)
		    (setq *ht-tmp* (if hl-a
				     (ht:paint layout base   ang
					       hgt    wf     lay
					       sty    obl    hl-from
					       hl-to
					      )
				     '()
				   )
		    )
		    (setq last-a hl-a
			  last-b hl-b
		    )
	     )
	   )
	  )
	  ((= code 2)
	   (cond
	     ((member data '(13 32))
	      (if (null hl-a)
		(princ "\n No char to hightlight")
		(progn
		  (setq	i 0
			new-lst	'()
		  )
		  (foreach ch chars
		    (cond ((< i hl-a) (setq new-lst (cons ch new-lst)))
			  ((= i hl-a)
			   (if (> (strlen input) 0)
			     (foreach nc (ht:chars input)
			       (setq new-lst (cons nc new-lst))
			     )
			   )
			  )
			  ((> i hl-b) (setq new-lst (cons ch new-lst)))
			  (t nil)
		    )
		    (setq i (1+ i))
		  )
		  (setq new-txt (apply 'strcat (reverse new-lst)))
		  (if (= new-txt "")
		    (setq new-txt " ")
		  )
		  (entmod (subst (cons 1 new-txt) (assoc 1 ed) ed))
		  (entupd hEnt)
		  (princ (strcat "\n Result: " new-txt))
		)
	      )
	      (setq running nil)
	     )
	     ((= data 8)
	      (if (> (strlen input) 0)
		(setq input (substr input 1 (1- (strlen input))))
	      )
	     )
	     ((= data 27) (setq running nil))
	     ((and (>= data 32) (< data 127))
	      (setq input (strcat input (chr data)))
	     )
	   )
	   (if running
	     (progn
	       (princ (strcat "\r Input: " input))
	       (if (< (strlen input) echo-last)
		 (princ (make-string (- echo-last (strlen input)) 32))
	       )
	       (setq echo-last (strlen input))
	     )
	   )
	  )
	  ((member code '(3 11 25)) (setq running nil))
	)
      )
      (princ)
    )
  )
)
(defun c:HTEXT (/ sel res)
  (setq sel (entsel "\n select a text <exit>: "))
  (if (null sel)
    (princ "\n nothing selected")
    (progn (setq *ht-tmp* '())
	   (setq res (vl-catch-all-apply 'ht:run (list sel)))
	   (ht:clear *ht-tmp*)
	   (setq *ht-tmp* nil)
	   (if (vl-catch-all-error-p res)
	     (princ
	       (strcat "\n error: " (vl-catch-all-error-message res))
	     )
	     (terpri)
	   )
    )
  )
  (princ)
)

Edited Saturday at 08:43 PM by SLW210
Added Code Tags and formatted code!!

[SLW210]

Please use code tags in the future. (<> in the text editor) and please post the code formatted.

[xcn]

Thanks @SLW210 for editing. I couldn't figure out how to format the code, but now I know how!

[SLW210]

From where did that LISP originate? 

 

Mandarin?

 

Glancing through that LISP a little, I am almost positive the best way would be to completely write something new.

[xcn]

I came up with it. If it could be completely rewritten, that would be great.

[BIGAL]

Not sure what your trying to achieve. Could you describe more. If it's about changing color then just use mtext.

Edited 11 hours ago by BIGAL

[xcn]

@BIGAL
The goal isn’t just to change color.

This AutoLISP routine is an interactive character-level editor for a single-line TEXT entity. It lets you:

1. Select an existing TEXT object.

2. Move the mouse along the text to highlight a range of characters.

3. Type replacement characters.

4. Press Enter or Space to replace the highlighted range in the original text.

The temporary red text created by ht:paint is only a visual highlight of the selected character range. It is not meant to permanently change color.

[SLW210]

I was just suggesting a rewrite, though I think maybe it is just a Unicode issue so it might be altered.

 

That's what I came back with on an internet search for change AutoCAD LISP from English input to Chinese and the articles I read stated Chinese has double-byte Unicode, the GRREAD may also be an issue.

 

LISPSYS=2 is necessary.

 

Quote

Controls the default AutoLISP development environment and, on AutoCAD for Windows only, the behavior of the VLISP command.

NOTE: The Visual LISP IDE (VL IDE) is supported in AutoCAD for Windows only.

Value    Description
0        AutoLISP functions don't fully support Unicode characters.
    Visual LISP IDE (VL IDE) is set as the default editor and launched with the VLISP command. AutoLISP source (LSP) files when saved and compiled use the ASCII (MBCS) character set. (Applies to AutoCAD for Windows only)
    NOTE: This setting results in the behavior of AutoCAD 2020 and earlier releases, and is supported on Windows only.
1        AutoLISP functions fully support Unicode characters.
    Visual Studio (VS) Code is set as the default editor and launched with the VLISP command. AutoLISP source (LSP) files, when saved, use the encoding set in VS Code, and when compiled, they use the Unicode character set. (Applies to AutoCAD only)
2        AutoLISP functions fully support Unicode characters.
    Visual Studio (VS) Code is set as the default editor and launched with the VLISP command. AutoLISP source (LSP) files, when saved, use the encoding set in VS Code, and when compiled they use the ASCII (MBCS) character set. (Applies to AutoCAD only)

 

 

Is this on a Chinese Simplified version of AutoCAD, Windows , etc.?

 

Give some more detailed information on the setups this will be used.

 

I just started studying Chinese a few weeks ago, so I want be a ton of help on that end and haven't got into the characters yet.