|
|
| Тема |
 Re: Проблем с кирилицата на AutoCad [re: plamen nikolaev stoy] |
|
| Автор |
magesnik (вълшебник) |
|
| Публикувано | 23.06.10 09:39 |
|
|
|
уффф... тоя форум трябва да го затворят вече... един човек дето да може акъл да даде не е останал. Пробвай с това, Пламене, някой навремето ми го написа тук този код, ама годинки минаха и едва ли си го намерил (друг път да търсиш по-усърдно ). Запиши долния код във файл ASCI_UNI.LSP. Зареди го с (load "ASCI_UNI"). Стартирай го с (ALLTEXT). Оправя текстове, мултитекстове, атрибути и атрибутни дефиниции.
;ascii to unicode
;избира файл за котвертиране
(defun conv-file ()
(If (setq filei (getfiled "" "" "" 0))
(conv-file1 filei)
);if filei
);conv-file
;чете файл и го котвертира
(defun conv-file1 (filei / file filenew li)
(if filei
(progn
(setq file(open filei "r")
filenew (open (strcat filei ".txt")"w"))
(while (setq li (READ-LINE file))
(WRITE-LINE (VL-STRING-TRIM " "(dtow li))filenew)
);while
(close file)
(close filenew)
);progn
);if file
);conv-file
(defun asc-uni (txt / a i b tete)
(setq
a (cdr(assoc 1(entget txt)))
tete ""
i 1
);setq
(setq tete (dtow a)txt (entget txt) txt (subst (cons 1 (dtow tete))(assoc 1 txt)txt))
(entmod txt)
);'(asc-un)
;-------------- hex-dec convert ------------
(defun h-d (cc / e ii sum)
(setq cc (substr cc 4) ii 1 sum 0)
(repeat 4
(setq
e (h-d1 (substr cc ii 1))
sum (+ sum (* e (expt 16 (- 4 ii ))))
ii (1+ ii)
);setq
);repeat
;(print cc)(princ sum)(princ (chr sum))
;(chr (+ sum 64))
(chr (rem sum 256))
);h-d
;--------- text to hex convert -----------
(defun h-d1 (cc / e)
(cond
((= cc "A")(setq e 10))
((= cc "B")(setq e 11))
((= cc "C")(setq e 12))
((= cc "D")(setq e 13))
((= cc "E")(setq e 14))
((= cc "F")(setq e 15))
(T (setq e (atoi cc)))
);cond
e
);h-d
; ---------- allatt --------------
(defun allatt ()
(setq nab (ssget "x" (list (cons 0 "INSERT")))
i 0
);setq
(if nab
(progn
(repeat (sslength nab)
(setq eni (ssname nab i) i (1+ i) en (entnext eni))
; (print "-------------------\n-----")
(if (assoc 66 (entget eni))
(while
(/= "SEQEND" (cdr(assoc 0 (entget en))))
(if (or
(= "TEXT" (cdr (assoc 0 (entget en))))
(= "ATTRIB" (cdr (assoc 0 (entget en))))
);OR
(PROGN
(SETQ ENE (SUBST (CONS 1 (DTOW (CDR(ASSOC 1 (ENTGET EN))))) (ASSOC 1 (ENTGET EN)) (ENTGET EN)))
(ENTMOD ENE)
);PROGN
);IF
(setq en (entnext en))
);while
);if
);repeat
));if
)
;allatt
;--------- alltext ----------------
(defun alltext ( / n)
(foreach n '("TEXT" "ATTRIB" "ATTDEF")
(alltext1 n)
);foreach
(mas-uni)
(allatt)
(S-ATTDEF)
(COMMAND "REGEN")
);alltext
(defun alltext1 (att / nab i en eni )
(setq nab (ssget "x" (list (cons 0 att)))
i 0
);setq
(if nab
(repeat (sslength nab)
(setq
en (cdr(assoc -1 (entget(ssname nab i))))
i (1+ i)
);setq
(asc-uni en)
);repeat
);if
;;; ;(eval(load "attdefcyr"))
;;; (COMMAND "REGEN")
);defun
;convert MTEXT asii-uni cod
(defun mas-uni (/ nab en eni txt i)
(setq nab (ssget "x" (list(cons 0 "MTEXT")))
i 0)
(if nab
(repeat (SSLENGTH nab)
(setq en (ssname nab i)
i (1+ i)
en (ENTGET en)
txt (dtow (cdr(assoc 1 en)))
en(SUBST (cons 1 txt)(assoc 1 en) en)
);sеtq
(if(setq txt(assoc 3 en))(setq en (subst (cons 3(dtow(cdr txt))) txt en)))
(ENTMOD en)
);repeat
);if
);mas-uni
;ПРЕВРЪЩА ОТ Win ТЕКСТ В DOS ----
(defun WtoD( text / tt i text1)
;®І Win ў DOS
(setq i 1 text1 "")
(repeat (strlen text)
(setq
tt (ascii (substr text i 1))
);setq
;(< tt 192)
(if (and t(> tt 127)) (setq tt (- tt 64)))
(setq text1 (strcat text1 (chr tt)))
(setq i (1+ i))
);repeat
text1
);Wtod
;ОТ DOS В Win
(defun DtoW ( text / i tt text1)
(setq i 1 text1 "" text(asc-un text))
(repeat (strlen text)
(setq
tt (ascii (substr text i 1))
)
(if (and(> tt 127)(< tt 192)) (setq tt (+ 64 tt)))
(setq text1 (strcat text1 (chr tt)))
(setq i (1+ i))
);repeat
text1
);DtoW
;---------- convert unicod-ansicod ----------------
(defun asc-un (txt / a i b tete)
(setq
a txt
tete ""
i 1
);setq
(while (<= i (strlen a))
(cond
((/= (setq b (substr a i 1)) "\\") (setq i (1+ i) tete (strcat tete b)))
((= (setq b (substr a i 3)) "\\U+")
(setq b(substr a i 7)
i (+ i 7)
tete (strcat tete(chr(h-d b)))
))
(T (setq tete(strcat tete(substr a i 1)) i (1+ i)))
);cond
);while
tete
);'(asc-un)
;-------------- hex-dec convert ------------
(defun h-d (cc / e ii sum)
(setq cc (substr cc 4) ii 1 sum 0)
(repeat (strlen CC)
(setq
e (h-d1 (substr cc ii 1))
sum (+ sum (* e (expt 16 (- 4 ii ))))
ii (1+ ii)
);setq
);repeat
;;; (chr (rem sum 256))
SUM
);h-d
;--------- text to hex convert -----------
(defun h-d1 (cc / e)
(cond
((= cc "A")(setq e 10))
((= cc "B")(setq e 11))
((= cc "C")(setq e 12))
((= cc "D")(setq e 13))
((= cc "E")(setq e 14))
((= cc "F")(setq e 15))
(T (setq e (atoi cc)))
);cond
e
);h-d
;чете ATTDEF И TEXT
(DEFUN S-ATTDEF (/ NAB EN ENT ENTI)
(SETQ EN (TBLNEXT "BLOCK" T)
ENT (CDR(ASSOC -2 EN))
);SETQ
;(REPEAT 10
(WHILE (SETQ EN (TBLNEXT "BLOCK" ))
(SETQ ENT (CDR(ASSOC -2 EN))
);SETQ
(WHILE ENT
(SETQ ENT (ENTNEXT ENT))
(IF (AND ENT
(OR
(=(CDR(ASSOC 0 (ENTGET ENT)))"ATTDEF")
(=(CDR(ASSOC 0 (ENTGET ENT)))"TEXT")
);OR
);AND
(PROGN
(SETQ ENTI(ENTGET ENT)
NAB(DTOW(CDR(ASSOC 1 ENTI)))
ENTI(subst (CONS 1 NAB)(ASSOC 1 ENTI)ENTI)
);SETQ
(ENTMOD ENTI)
(ENTUPD (CDR(ASSOC -1 ENTI)))
);PROGN
);IF
);REPEAT
);WHILE
);S-ATTDEF
'(alltext)
Магьосниците не закъсняват, нито идват по-рано. Те пристигат точно когато им е угодно
| |
| |
| 
|
|
