调用umi-ocr.exe识别pdf图片文字

本帖最后由 dcl1214 于 2026-2-5 11:05 编辑

(defun $umi-ocr-http$ (ip port imgpath
lst / $16-to-10$
$file->base64$ $json-zhuan-lisp$
$str-duan-kai$ $str-ti-huan$
$str-zhuan-unicode$
$unicode10-zhuan-str$
$unicode-zhuan-huan$ b64
data http i
json open-zt resp
send-zt str url
)
(defun $unicode-zhuan-huan$ (str / a b b1 b2 r x)
;unicode转码
(if (and str (= (type str) 'str))
(progn
(setq r "")
(while (/= "" (setq a (substr str 1 1)))
(setq str (substr str 2))
(if (= a "\\")
(progn
(setq b (substr str 1 1))
(setq str (substr str 2))
(cond
((= b "u")
(setq b1 (substr str 1 2))
(setq b2 (substr str 3 2))
(setq str (substr str 5))
(setq x ($unicode10-zhuan-Str$
(list ($16-to-10$ b2) ($16-to-10$ b1))
)
)
)
(t
(setq x (strcat a b))
)
)
)
(setq x a)
)
(setq r (strcat r x))
)
)
)
r ;返回
)
(defun $json-zhuan-lisp$ (str /
atom-str-lst curr-char
flag-arraylevel
flag-escape flag-keylevel
flag-quote lst-str
pre-char s
)
;Json 字符串转化为 lisp 列表
(if str
(progn
(setq lst-str (vl-string->list str))
(setq flag-escape nil)
(setq flag-quote nil)
(setq flag-keylevel 0)
(setq flag-arraylevel 0)
(setq atom-str-lst '())
(while lst-str
(setq curr-char (car lst-str))
(cond
((= (ascii "\\") curr-char)
(setq flag-escape (not flag-escape))
(setq atom-str-lst (cons curr-char atom-str-lst))
)
((and (= (ascii "\"") curr-char)
(null flag-escape)
)
(setq flag-escape nil)
(setq flag-quote (not flag-quote))
(setq atom-str-lst (cons curr-char atom-str-lst))
)
(t
(setq flag-escape nil)
(if flag-quote
(setq atom-str-lst (cons curr-char atom-str-lst))
(cond
((= (ascii "{") curr-char)
;;对象 key/value mode
(setq flag-keylevel (1+ flag-keylevel))
(setq atom-str-lst (cons (ascii "(") atom-str-lst))
)
((= (ascii "[") curr-char)
;;array mode
(setq flag-arraylevel (1+ flag-arraylevel))
(if (= pre-char (ascii ":"))
(setq atom-str-lst
(cons (ascii "(") (cdddr atom-str-lst))
)
(setq atom-str-lst (cons (ascii "(") atom-str-lst))
)
)
((= (ascii "}") curr-char)
;;对象 key/value mode
(setq flag-keylevel (1- flag-keylevel))
(setq atom-str-lst (cons (ascii ")") atom-str-lst))
)
((= (ascii "]") curr-char)
;;array mode
(setq flag-arraylevel (1- flag-arraylevel))
(setq atom-str-lst (cons (ascii ")") atom-str-lst))
)
((= (ascii ":") curr-char)
;; 处理 key
(setq atom-str-lst
(cons (ascii " ")
(cons (ascii ".")
(cons (ascii " ") atom-str-lst)
)
)
)
)
((= (ascii ",") curr-char)
;; value
(setq atom-str-lst
(cons (ascii "(")
(cons (ascii ")")
atom-str-lst
)
)
)
)
(t (setq atom-str-lst (cons curr-char atom-str-lst)))
)
)
)
)
(setq pre-char curr-char)
(setq lst-str (cdr lst-str))
)
(setq
s
(read
(strcat "(" (vl-list->string (reverse atom-str-lst)) ")")
)
)
)
)
s
)
(defun $unicode10-zhuan-Str$ (decList / stream result saFileGet)
;将unicode编码的十进制数据表转换为字符串
(if (and decList)
(progn
(if (and (setq stream (vl-catch-all-apply
'vlax-create-object
(list "Adodb.Stream")
)
)
(not (vl-catch-all-error-p stream))
)
(progn
(vlax-put-property stream 'Type 1)
; 1二进制读取 2文本模式读取
(vlax-invoke stream 'Open)
;; 打开流
(setq saFileGet (vl-catch-all-apply
'vlax-make-safearray
(list
17
(cons 0 (1- (length decList)))
)
)
)
;; 创建SafeArray
(if (vl-catch-all-error-p saFileGet)
(setq saFileGet nil)
)
(vl-catch-all-apply
'vlax-safearray-fill
(list saFileGet decList)
)
;; 填充SafeArray
(vl-catch-all-apply
'Vlax-Invoke-Method
(list stream 'Write saFileGet)
)
;; 写入二进制数据
(vl-catch-all-apply
'vlax-put-property
(list stream 'Position 0)
)
;; 将位置重置为起始位置
(vl-catch-all-apply
'vlax-put-property
(list stream 'Type 2)
) ; 2文本模式读取
(vl-catch-all-apply
'vlax-put-property
(list stream 'Charset "unicode")
)
(setq result (vl-catch-all-apply
'Vlax-Invoke-Method
(list stream 'ReadText nil)
)
)
;; 读取文本数据
(vlax-release-object stream)
;; 释放对象
(if (vl-catch-all-error-p result)
(setq result nil)
)
)
(print "无法创建'Adodb.Stream'对象")
)
)
)
result ;返回
)
(defun $str-zhuan-unicode$ (str / file_list fileget jg stream)
;将任意字符串转换为unicode编码，返回十进制数据表
(if
(and (setq stream (vl-catch-all-apply
'vlax-create-object
(list "Adodb.Stream")
)
)
(not (vl-catch-all-error-p stream))
)
(progn
(vl-catch-all-apply
'vlax-put-property
(list stream 'Type 2)
) ; 1二进制读取 2文本模式读取
(vl-catch-all-apply
'vlax-put-property
(list stream 'Mode 3)
) ; 1-读,2-写,3-读写
(vl-catch-all-apply
'vlax-put-property
(list stream 'Charset "unicode")
) ; 设置编码为UTF-8
(vl-catch-all-apply 'vlax-invoke (list stream 'Open))
(vl-catch-all-apply
'vlax-invoke
(list stream 'WriteText str)
)
(vl-catch-all-apply
'vlax-put-property
(list stream 'Position 0)
) ; 将位置重置为起始位置
(vl-catch-all-apply
'vlax-put-property
(list stream 'Type 1)
) ; 1二进制读取 2文本模式读取
(setq FileGet (vl-catch-all-apply
'Vlax-Invoke-Method
(list stream 'Read nil)
)
)
(setq
File_list (vl-catch-all-apply
'vlax-safearray->list
(list (vl-catch-all-apply
'vlax-variant-value
(list FileGet)
)
)
)
)
(vlax-release-object stream)
(setq jg (cddr File_list)) ;去除BOM
)
(princ "\n无法创建'Adodb.Stream'对象")
)
jg ;返回
)
(defun $file->Base64$ (FileName / node size str stream xmldom)
;文件转base64
(setq xmldom (vl-catch-all-apply
'vlax-create-object
(list "Microsoft.XMLDOM")
)
)
(setq node (vl-catch-all-apply
'vlax-invoke-method
(list xmldom 'CreateElement "TEST")
)
)
(vl-catch-all-apply
'vlax-put-Property
(list node 'DataType "bin.base64")
)
(setq stream (vl-catch-all-apply
'vlax-create-object
(list "ADODB.Stream")
)
)
(vl-catch-all-apply
'vlax-put-Property
(list stream 'type 1)
)
(vl-catch-all-apply 'Vlax-Invoke (list stream 'open))
(vl-catch-all-apply
'vlax-invoke-method
(list
stream
'LoadFromFile
FileName
)
)
(setq
size (vl-catch-all-apply 'vlax-get-Property (list stream 'size))
)
(vl-catch-all-apply
'vlax-put-Property
(list
node
'NodeTypedValue
(Vlax-Invoke-Method stream 'Read size)
)
)
(vl-catch-all-apply
'Vlax-Invoke-Method
(list stream 'close)
)
(setq str (vl-catch-all-apply 'vlax-get-Property (list node 'text)))
(and xmldom
(vl-catch-all-apply 'vlax-release-object (list xmldom))
)
str ;返回
)
(defun $str-ti-huan$ (str a b)
;字符串替换
(if (and (= (type str) 'str)
(apply 'and
(mapcar (function (lambda (x) (= (type x) 'str)))
(setq a (if (= (type a) 'list)
a
(list a)
)
)
)
)
(apply 'and
(mapcar (function (lambda (x) (= (type x) 'str)))
(setq b (if (= (type b) 'list)
b
(mapcar (function (lambda (x) b)) a)
)
)
)
)
)
(setq str ($str-duan-kai$ str a nil)
str (apply
'strcat
(mapcar 'strcat
(car str)
(mapcar (function (lambda (x)
(if (= "" x)
x
(nth (vl-position x a) b)
)
)
)
(last str)
)
)
)
)
str
)
)
(defun $str-duan-kai$ (str splits f / a b i l s)
;文字断开
(if (and str splits (= (type str) 'str) (= (type splits) 'list))
(progn
(if f
(setq
str (vl-list->string (vl-remove 32 (vl-string->list str)))
)
)
(while (< "" str)
(if
(vl-remove
'nil
(mapcar (function (lambda (x) (vl-string-search x str)))
splits
)
)
(setq i (car
(vl-sort
(vl-remove
'nil
(mapcar
(function
(lambda (x)
(if (setq l (vl-string-search x str))
(cons l x)
)
)
)
splits
)
)
(function (lambda (s1 s2) (< (car s1) (car s2))))
)
)
a (cons (substr str 1 (car i)) a)
b (cons (cdr i) b)
str (substr str (+ (car i) (strlen (cdr i)) 1))
)
(setq a (cons str a)
b (cons "" b)
str ""
)
)
)
(setq s (list (reverse a) (reverse b)))
)
)
s ;返回
)
(defun $16-to-10$ (n / 16-10 f i ii j m)
;16进制转10进制
(if (and n (= (type n) 'str))
(progn
(setq n (strcase n))
(setq i 0
j (strlen n)
m 0
16-10 '(("0" 0)
("1" 1)
("2" 2)
("3" 3)
("4" 4)
("5" 5)
("6" 6)
("7" 7)
("8" 8)
("9" 9)
("A" 10)
("B" 11)
("C" 12)
("D" 13)
("E" 14)
("F" 15)
)
)
(repeat j
(setq
f (substr n j 1)
ii (cadr (assoc f 16-10))
m (+ m (* (expt 16 i) ii))
i (1+ i)
j (1- j)
)
)
)
)
m ;返回
)
;奔跑
(or ip (setq ip "http://127.0.0.1"))
(or port (setq port "1224"))
(setq b64 ($file->Base64$ imgpath)
b64 ($str-ti-huan$ b64 "\n" "")
)
(setq json
(strcat
"{" "\"base64\":\"" b64
"\"," "\"options\":{"
"\"data.format\":\"text\"" "}"
"}"
)
)
(setq http (vl-catch-all-apply
'vlax-create-object
(list "Msxml2.XMLHTTP")
)
)
(if (vl-catch-all-error-p http)
(progn (print "创建Msxml2.XMLHTTP对象失败") (setq http nil))
)
(setq url (strcat ip ":" port "/api/ocr"))
(cond
((and ip (wcmatch ip "[,*`:[0-9]*,]"))
(setq url (strcat ip "/api/ocr"))
)
(t
(setq url (strcat ip ":" port "/api/ocr"))
)
)
(setq open-zt (vl-catch-all-apply
'vlax-invoke
(list http 'Open "POST" url 0)
)
)
(vlax-invoke
http
'SetRequestHeader
"Content-Type"
"application/json"
)
(setq
Send-zt (vl-catch-all-apply 'vlax-invoke (list http 'Send json))
)
(if (vl-catch-all-error-p Send-zt)
(print "umi-ocr.exe可能没启动，或者是端口号不对导致send失败"
)
)
(setq i 0)
(while (and (/= (vl-catch-all-apply
'vlax-get-property
(list http 'readyState)
)
4
)
(< i 500)
)
(REPEAT 5000)
(SETQ i (1+ i))
)
(if
(and http
(/= (vl-catch-all-apply 'vlax-get-property (list http 'status))
200
)
)
(print "umi-ocr.exe可能没启动，或者是端口号不对")
)
(setq resp (vl-catch-all-apply
'vlax-get-property
(list http 'responseText)
)
)
(if http
(vlax-release-object http)
)
(setq str ($unicode-zhuan-huan$ resp))
(setq lst ($json-zhuan-lisp$ str))
(setq data (cdr (assoc "data" lst)))
data
)
(defun c:tt (/ data lst result str)
(setq
data ($umi-ocr-http$ "http://127.0.0.1" "1224" "C:\\1.png" nil)
)
)

(defun $umi-ocr-http$ (ip         port         imgpath 
           lst         /         $16-to-10$ 
           $file->base64$  $json-zhuan-lisp$ 
           $str-duan-kai$  $str-ti-huan$ 
           $str-zhuan-unicode$ 
           $unicode10-zhuan-str$ 
           $unicode-zhuan-huan$         b64 
           data         http         i 
           json         open-zt         resp 
           send-zt         str         url 
          ) 
  (defun $unicode-zhuan-huan$ (str / a b b1 b2 r x) 
          ;unicode转码 
    (if  (and str (= (type str) 'str)) 
      (progn 
  (setq r "") 
  (while (/= "" (setq a (substr str 1 1))) 
    (setq str (substr str 2)) 
    (if (= a "\\") 
      (progn 
        (setq b (substr str 1 1)) 
        (setq str (substr str 2)) 
        (cond 
    ((= b "u") 
     (setq b1 (substr str 1 2)) 
     (setq b2 (substr str 3 2)) 
     (setq str (substr str 5)) 
     (setq x ($unicode10-zhuan-Str$ 
         (list ($16-to-10$ b2) ($16-to-10$ b1)) 
       ) 
     ) 
    ) 
    (t 
     (setq x (strcat a b)) 
    ) 
        ) 
      ) 
      (setq x a) 
    ) 
    (setq r (strcat r x)) 
  ) 
      ) 
    ) 
    r          ;返回 
  ) 
  (defun $json-zhuan-lisp$ (str       / 
          atom-str-lst   curr-char 
          flag-arraylevel 
          flag-escape     flag-keylevel 
          flag-quote     lst-str 
          pre-char     s 
         ) 
          ;Json 字符串转化为 lisp 列表 
    (if  str 
      (progn 
  (setq lst-str (vl-string->list str)) 
  (setq flag-escape nil) 
  (setq flag-quote nil) 
  (setq flag-keylevel 0) 
  (setq flag-arraylevel 0) 
  (setq atom-str-lst '()) 
  (while lst-str 
    (setq curr-char (car lst-str)) 
    (cond 
      ((= (ascii "\\") curr-char) 
       (setq flag-escape (not flag-escape)) 
       (setq atom-str-lst (cons curr-char atom-str-lst)) 
      ) 
      ((and (= (ascii "\"") curr-char) 
      (null flag-escape) 
       ) 
       (setq flag-escape nil) 
       (setq flag-quote (not flag-quote)) 
       (setq atom-str-lst (cons curr-char atom-str-lst)) 
      ) 
      (t 
       (setq flag-escape nil) 
       (if flag-quote 
         (setq atom-str-lst (cons curr-char atom-str-lst)) 
         (cond 
     ((= (ascii "{") curr-char) 
      ;;对象 key/value mode 
      (setq flag-keylevel (1+ flag-keylevel)) 
      (setq atom-str-lst (cons (ascii "(") atom-str-lst)) 
     ) 
     ((= (ascii "[") curr-char) 
      ;;array mode 
      (setq flag-arraylevel (1+ flag-arraylevel)) 
      (if (= pre-char (ascii ":")) 
        (setq atom-str-lst 
         (cons (ascii "(") (cdddr atom-str-lst)) 
        ) 
        (setq atom-str-lst (cons (ascii "(") atom-str-lst)) 
      ) 
     ) 
     ((= (ascii "}") curr-char) 
      ;;对象 key/value mode 
      (setq flag-keylevel (1- flag-keylevel)) 
      (setq atom-str-lst (cons (ascii ")") atom-str-lst)) 
     ) 
     ((= (ascii "]") curr-char) 
      ;;array mode 
      (setq flag-arraylevel (1- flag-arraylevel)) 
      (setq atom-str-lst (cons (ascii ")") atom-str-lst)) 
     ) 
 
     ((= (ascii ":") curr-char) 
      ;; 处理 key 
      (setq  atom-str-lst 
       (cons (ascii " ") 
             (cons (ascii ".") 
             (cons (ascii " ") atom-str-lst) 
             ) 
       ) 
      ) 
     ) 
     ((= (ascii ",") curr-char) 
      ;; value 
      (setq  atom-str-lst 
       (cons (ascii "(") 
             (cons (ascii ")") 
             atom-str-lst 
             ) 
       ) 
      ) 
     ) 
     (t (setq atom-str-lst (cons curr-char atom-str-lst))) 
         ) 
       ) 
      ) 
    ) 
    (setq pre-char curr-char) 
    (setq lst-str (cdr lst-str)) 
  ) 
  (setq 
    s 
     (read 
       (strcat "(" (vl-list->string (reverse atom-str-lst)) ")") 
     ) 
  ) 
      ) 
    ) 
    s 
  ) 
  (defun $unicode10-zhuan-Str$ (decList / stream result saFileGet) 
          ;将unicode编码的十进制数据表转换为字符串 
    (if  (and decList) 
      (progn 
  (if (and (setq stream (vl-catch-all-apply 
        'vlax-create-object 
        (list "Adodb.Stream") 
            ) 
     ) 
     (not (vl-catch-all-error-p stream)) 
      ) 
    (progn 
      (vlax-put-property stream 'Type 1) 
          ; 1二进制读取 2文本模式读取 
      (vlax-invoke stream 'Open) 
      ;; 打开流 
      (setq saFileGet (vl-catch-all-apply 
            'vlax-make-safearray 
            (list 
        17 
        (cons 0 (1- (length decList))) 
            ) 
          ) 
      ) 
      ;; 创建SafeArray 
      (if  (vl-catch-all-error-p saFileGet) 
        (setq saFileGet nil) 
      ) 
      (vl-catch-all-apply 
        'vlax-safearray-fill 
        (list saFileGet decList) 
      ) 
      ;; 填充SafeArray 
      (vl-catch-all-apply 
        'Vlax-Invoke-Method 
        (list stream 'Write saFileGet) 
      ) 
      ;; 写入二进制数据 
      (vl-catch-all-apply 
        'vlax-put-property 
        (list stream 'Position 0) 
      ) 
      ;; 将位置重置为起始位置 
      (vl-catch-all-apply 
        'vlax-put-property 
        (list stream 'Type 2) 
      )        ; 2文本模式读取 
      (vl-catch-all-apply 
        'vlax-put-property 
        (list stream 'Charset "unicode") 
      ) 
      (setq result (vl-catch-all-apply 
         'Vlax-Invoke-Method 
         (list stream 'ReadText nil) 
       ) 
      ) 
      ;; 读取文本数据 
      (vlax-release-object stream) 
      ;; 释放对象 
      (if  (vl-catch-all-error-p result) 
        (setq result nil) 
      ) 
    ) 
    (print "无法创建'Adodb.Stream'对象") 
  ) 
      ) 
    ) 
    result        ;返回 
  ) 
  (defun $str-zhuan-unicode$ (str / file_list fileget jg stream) 
          ;将任意字符串转换为unicode编码，返回十进制数据表 
    (if 
      (and (setq stream  (vl-catch-all-apply 
        'vlax-create-object 
        (list "Adodb.Stream") 
      ) 
     ) 
     (not (vl-catch-all-error-p stream)) 
      ) 
       (progn 
   (vl-catch-all-apply 
     'vlax-put-property 
     (list stream 'Type 2) 
   )        ; 1二进制读取 2文本模式读取 
   (vl-catch-all-apply 
     'vlax-put-property 
     (list stream 'Mode 3) 
   )        ; 1-读,2-写,3-读写 
   (vl-catch-all-apply 
     'vlax-put-property 
     (list stream 'Charset "unicode") 
   )        ; 设置编码为UTF-8 
   (vl-catch-all-apply 'vlax-invoke (list stream 'Open)) 
   (vl-catch-all-apply 
     'vlax-invoke 
     (list stream 'WriteText str) 
   ) 
   (vl-catch-all-apply 
     'vlax-put-property 
     (list stream 'Position 0) 
   )        ; 将位置重置为起始位置 
   (vl-catch-all-apply 
     'vlax-put-property 
     (list stream 'Type 1) 
   )        ; 1二进制读取 2文本模式读取 
   (setq FileGet (vl-catch-all-apply 
       'Vlax-Invoke-Method 
       (list stream 'Read nil) 
           ) 
   ) 
   (setq 
     File_list (vl-catch-all-apply 
           'vlax-safearray->list 
           (list (vl-catch-all-apply 
             'vlax-variant-value 
             (list FileGet) 
           ) 
           ) 
         ) 
   ) 
   (vlax-release-object stream) 
   (setq jg (cddr File_list))  ;去除BOM 
       ) 
       (princ "\n无法创建'Adodb.Stream'对象") 
    ) 
    jg          ;返回 
  ) 
 
 
  (defun $file->Base64$  (FileName / node size str stream xmldom) 
          ;文件转base64 
    (setq xmldom (vl-catch-all-apply 
       'vlax-create-object 
       (list "Microsoft.XMLDOM") 
     ) 
    ) 
    (setq node (vl-catch-all-apply 
     'vlax-invoke-method 
     (list xmldom 'CreateElement "TEST") 
         ) 
    ) 
    (vl-catch-all-apply 
      'vlax-put-Property 
      (list node 'DataType "bin.base64") 
    ) 
    (setq stream (vl-catch-all-apply 
       'vlax-create-object 
       (list "ADODB.Stream") 
     ) 
    ) 
    (vl-catch-all-apply 
      'vlax-put-Property 
      (list stream 'type 1) 
    ) 
    (vl-catch-all-apply 'Vlax-Invoke (list stream 'open)) 
    (vl-catch-all-apply 
      'vlax-invoke-method 
      (list 
  stream 
  'LoadFromFile 
  FileName 
      ) 
    ) 
    (setq 
      size (vl-catch-all-apply 'vlax-get-Property (list stream 'size)) 
    ) 
    (vl-catch-all-apply 
      'vlax-put-Property 
      (list 
  node 
  'NodeTypedValue 
  (Vlax-Invoke-Method stream 'Read size) 
      ) 
    ) 
    (vl-catch-all-apply 
      'Vlax-Invoke-Method 
      (list stream 'close) 
    ) 
    (setq str (vl-catch-all-apply 'vlax-get-Property (list node 'text))) 
    (and xmldom 
   (vl-catch-all-apply 'vlax-release-object (list xmldom)) 
    ) 
    str          ;返回 
  ) 
  (defun $str-ti-huan$ (str a b) 
          ;字符串替换 
    (if  (and (= (type str) 'str) 
       (apply 'and 
        (mapcar (function (lambda (x) (= (type x) 'str))) 
          (setq a (if  (= (type a) 'list) 
              a 
              (list a) 
            ) 
          ) 
        ) 
       ) 
       (apply 'and 
        (mapcar (function (lambda (x) (= (type x) 'str))) 
          (setq b (if  (= (type b) 'list) 
              b 
              (mapcar (function (lambda (x) b)) a) 
            ) 
          ) 
        ) 
       ) 
  ) 
      (setq str  ($str-duan-kai$ str a nil) 
      str  (apply 
      'strcat 
      (mapcar 'strcat 
        (car str) 
        (mapcar (function (lambda (x) 
                (if (= "" x) 
            x 
            (nth (vl-position x a) b) 
                ) 
              ) 
          ) 
          (last str) 
        ) 
      ) 
    ) 
      ) 
      str 
    ) 
  ) 
 
  (defun $str-duan-kai$  (str splits f / a b i l s) 
          ;文字断开 
    (if  (and str splits (= (type str) 'str) (= (type splits) 'list)) 
      (progn 
  (if f 
    (setq 
      str  (vl-list->string (vl-remove 32 (vl-string->list str))) 
    ) 
  ) 
  (while (< "" str) 
    (if 
      (vl-remove 
        'nil 
        (mapcar (function (lambda (x) (vl-string-search x str))) 
          splits 
        ) 
      ) 
       (setq i   (car 
       (vl-sort 
         (vl-remove 
           'nil 
           (mapcar 
             (function 
         (lambda (x) 
           (if (setq l (vl-string-search x str)) 
             (cons l x) 
           ) 
         ) 
             ) 
             splits 
           ) 
         ) 
         (function (lambda (s1 s2) (< (car s1) (car s2)))) 
       ) 
           ) 
       a   (cons (substr str 1 (car i)) a) 
       b   (cons (cdr i) b) 
       str (substr str (+ (car i) (strlen (cdr i)) 1)) 
       ) 
       (setq a   (cons str a) 
       b   (cons "" b) 
       str "" 
       ) 
    ) 
  ) 
  (setq s (list (reverse a) (reverse b))) 
      ) 
    ) 
    s          ;返回 
  ) 
  (defun $16-to-10$ (n / 16-10 f i ii j m) 
          ;16进制转10进制 
    (if  (and n (= (type n) 'str)) 
      (progn 
  (setq n (strcase n)) 
  (setq i      0 
        j      (strlen n) 
        m      0 
        16-10 '(("0" 0) 
          ("1" 1) 
          ("2" 2) 
          ("3" 3) 
          ("4" 4) 
          ("5" 5) 
          ("6" 6) 
          ("7" 7) 
          ("8" 8) 
          ("9" 9) 
          ("A" 10) 
          ("B" 11) 
          ("C" 12) 
          ("D" 13) 
          ("E" 14) 
          ("F" 15) 
         ) 
  ) 
  (repeat  j 
    (setq 
      f  (substr n j 1) 
      ii (cadr (assoc f 16-10)) 
      m  (+ m (* (expt 16 i) ii)) 
      i  (1+ i) 
      j  (1- j) 
    ) 
  ) 
      ) 
    ) 
    m          ;返回 
  ) 
          ;奔跑 
  (or ip (setq ip "http://127.0.0.1")) 
  (or port (setq port "1224")) 
  (setq  b64 ($file->Base64$ imgpath) 
  b64 ($str-ti-huan$ b64 "\n" "") 
  ) 
  (setq  json 
   (strcat 
     "{"          "\"base64\":\""   b64 
     "\","        "\"options\":{" 
     "\"data.format\":\"text\""     "}" 
     "}" 
    ) 
  ) 
  (setq  http (vl-catch-all-apply 
         'vlax-create-object 
         (list "Msxml2.XMLHTTP") 
       ) 
  ) 
  (if (vl-catch-all-error-p http) 
    (progn (print "创建Msxml2.XMLHTTP对象失败") (setq http nil)) 
  ) 
  (setq url (strcat ip ":" port "/api/ocr")) 
  (cond 
    ((and ip (wcmatch ip "[,*`:[0-9]*,]")) 
     (setq url (strcat ip "/api/ocr")) 
    ) 
    (t 
     (setq url (strcat ip ":" port "/api/ocr")) 
    ) 
  ) 
  (setq  open-zt  (vl-catch-all-apply 
      'vlax-invoke 
      (list http 'Open "POST" url 0) 
    ) 
  ) 
  (vlax-invoke 
    http 
    'SetRequestHeader 
    "Content-Type" 
    "application/json" 
  ) 
  (setq 
    Send-zt (vl-catch-all-apply 'vlax-invoke (list http 'Send json)) 
  ) 
  (if (vl-catch-all-error-p Send-zt) 
    (print "umi-ocr.exe可能没启动，或者是端口号不对导致send失败" 
    ) 
  ) 
  (setq i 0) 
  (while (and (/= (vl-catch-all-apply 
        'vlax-get-property 
        (list http 'readyState) 
      ) 
      4 
        ) 
        (
   ) 
    (REPEAT 5000) 
    (SETQ i (1+ i)) 
  ) 
  (if 
    (and http 
   (/= (vl-catch-all-apply 'vlax-get-property (list http 'status)) 
       200 
   ) 
    ) 
     (print "umi-ocr.exe可能没启动，或者是端口号不对") 
  ) 
  (setq  resp (vl-catch-all-apply 
         'vlax-get-property 
         (list http 'responseText) 
       ) 
  ) 
  (if http 
    (vlax-release-object http) 
  ) 
  (setq str ($unicode-zhuan-huan$ resp)) 
  (setq lst ($json-zhuan-lisp$ str)) 
  (setq data (cdr (assoc "data" lst))) 
  data 
) 
(defun c:tt (/ data lst result str) 
  (setq 
    data ($umi-ocr-http$ "http://127.0.0.1" "1224" "C:\\1.png" nil) 
  ) 
)

网友答:

强烈点赞，楼主大牛

网友答: ($umi-ocr-http$ "http://127.0.0.1" "1224" "C:\\1.png" nil)中1224是什么东西？

网友答:

自贡黄明儒发表于 2026-2-5 07:19
($umi-ocr-http$ "http://127.0.0.1" "1224" "C:\\1.png" nil)中1224是什么东西？

1224是端口号吧

网友答: 太高端了不知道如何用专门查了下端口号但是仍连接不上显示 "umi-ocr.exe可能没启动，或者是端口号不对"

网友答: 本帖最后由 tryhi 于 2026-2-5 11:21 编辑

自贡黄明儒发表于 2026-2-5 07:19
($umi-ocr-http$ "http://127.0.0.1" "1224" "C:\\1.png" nil)中1224是什么东西？

1224是umi-ocr的默认端口号，其实这个umi-ocr的参数挺多的，可以返回文字坐标，也支持二维码扫码什么的

网友答: 可以打开了原来以为是连接网上的东西自动识别后来发现要先下载app安装哈哈

网友答: 本帖最后由 guosheyang 于 2026-2-5 12:16 编辑

请教大佬们，如何利用该ocr的坐标功能，返回cad中图片识别文字的坐标呢，即每个识别后的文字相对于图片左下角左上角点的相对坐标，这样就可以识别cad中的图片文字，并置于原来栅格文字的位置，大小完全重合，以前看到过有人实现过此功能，不知道是咋实现的，谢谢！

网友答: 识别了，厉害。
https://bbs.mjtd.com/forum.php?mod=attachment&aid=MTQ4ODc5fDJjMDg3NmUzOTFiOTBlNDZjMDMwYTNiNDRjOWYwYjkyfDE3NzAzOTg2MzE%3D&request=yes&_f=.png

网友答: 每个字分组，获取该组左下角坐标，识别文字后插到这个坐标

上一篇：lwpolyline加段的写法

下一篇：没有了