Поиск русских букв в чертежах на английском языке.

dpmoucpi · 10.12.2010, 11:54

Добрый день.
Появилась такая проблема:
Чертежи необходимо сдавать на английском языке. У заказчика установлена система которая проверяет чертежи (вплоть до толщины линии) и если на чертеже есть буквы на русском языке она их не принимает.
То-ли в силу своей не внимательности или по другой причине но проектировщики иногда вводят русские буквы вместо английских.
Кто может подсказать как бы так находить русские буквы на чертежах?

dpmoucpi · 07.02.2011, 14:51

Ошибка в AutoCad: "неверный тип аргумента: lentityp nil"

код:

Код:

[Выделить все]

(defun C:R2E ( / *error* Doc)
;;;Rus To Eng
(vl-load-com) 
(defun *error* (msg)(princ msg)
(bg:layer-status-restore)
(vla-endundomark Doc)(princ)
)
(setq Doc (vla-get-activedocument (vlax-get-acad-object)))
(bg:layer-status-save)(vla-startundomark Doc)
(Translate-All-String-Objects Doc)
(bg:layer-status-restore)(vla-endundomark Doc)
(princ)
)

(defun Translate-All-String-Objects (Doc / txtstr tmp txt count)
  (foreach item '("LAYER" "LTYPE" "VIEW" "STYLE" "BLOCK" "UCS" "APPID" "DIMSTYLE" "VPORT")
    (foreach item1 (tablelist  item)
      (entmod
      (mapcar '(lambda(pair)
	     (cons (car pair)
		   (if (= (type (cdr pair)) 'STR)
		       (trans-from-rus-to-translit (cdr pair))
		      (cdr pair)
		     )
		   )
	     )
	  (entget(tblobjname item item1))
	  )
      )
      )
    )
(vlax-for Blk	(vla-get-Blocks Doc)
(if (= (vla-get-IsXref Blk) :vlax-false)
(progn
(setq count 0 txt (strcat "Changed " (vla-get-name Blk)))
(grtext -1 txt)
(vlax-for	Obj Blk
(setq count (1+ count))
(if (zerop(rem count 10))(grtext -1 (strcat txt " : " (itoa count))))
(if (and (vlax-write-enabled-p Obj)
         (vlax-property-available-p Obj 'TextString)
) ;_ end of and
(progn
  (entmod
  (mapcar '(lambda(pair)
	     (cons (car pair)
		   (if (= (type (cdr pair)) 'STR)
		       (trans-from-rus-to-translit (cdr pair))
		      (cdr pair)
		     )
		   )
	     )
	  (entget (vlax-vla-object->ename Obj))
	  )
  )
)
) ;_ end of if
) ;_ end of vlax-for
)
) ;_ end of if
) ;_ end of vlax-for
(vl-cmdf "_regenall")
)
(defun trans-from-rus-to-translit ( str / translit)(vl-load-com) 
;;; http://www.caduser.ru/cgi-bin/f1/board.cgi?t=28488Sx
;;; http://forum.dwg.ru/showthread.php?t=13063
;;; Соответствие символов взято с translit.ru
;;; по мотивам http://www.caduser.ru/cgi-bin/f1/board.cgi?t=28488Sx
;;; name - исходная строка 
;;; возвращается преобразованная 
(setq translit 
'(("А" "A")("Б" "B")("В" "B")("Г" "G")("Д" "D")("Е" "E")("І" "I")("К" "K")("М" "M")("Н" "H")("О" "O")("Р" "P")("С" "C")("Т" "T")("Х" "X")("а" "a")("б" "b")("е" "e")("к" "k")("м" "m")("о" "o")("р" "p")("т" "t")("х" "x")("у" "y")("Э" "E")("с" "c"))) 

(apply 'strcat 
(mapcar '(lambda (x / sym) 
(if (setq sym (assoc x translit)) 
(cadr sym) 
x 
) ;_ конец if 
) ;_ конец lambda 
(mapcar 'chr (vl-string->list str)) 
) ;_ конец mapcar 
) ;_ конец apply
)
(defun tablelist (s / d r)
 (while (setq d (tblnext s (null d)))
   (setq r (cons (cdr (assoc 2 d)) r))
)
)
(defun bg:layer-status-restore ()
(foreach item *PD_LAYER_LST*
(if (not (vlax-erased-p (car item)))
(vl-catch-all-apply
'(lambda ()
(vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
(vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of if
) ;_ end of foreach
(setq *PD_LAYER_LST* nil)
) ;_ end of defun

(defun bg:layer-status-save ()
(setq *PD_LAYER_LST* nil)
(vlax-for item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
(setq *PD_LAYER_LST* (cons (list item
(cons "freeze" (vla-get-freeze item))
(cons "lock" (vla-get-lock item))
) ;_ end of cons
*PD_LAYER_LST*
) ;_ end of cons
) ;_ end of setq
(vla-put-lock item :vlax-false)
(if (= (vla-get-freeze item) :vlax-true)
(vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false))))
) ;_ end of vlax-for
) ;_ end of defun

VVA · 07.02.2011, 16:21

Обновил #59

dpmoucpi · 16.03.2011, 14:57

Код начал менять шрифты и некоторые знаки

Код:

[Выделить все]

(defun C:R2E ( / *error* Doc)
;;;Rus To Eng
(vl-load-com) 
(defun *error* (msg)(princ msg)
(bg:layer-status-restore)
(vla-endundomark Doc)(princ)
)
(setq Doc (vla-get-activedocument (vlax-get-acad-object)))
(bg:layer-status-save)(vla-startundomark Doc)
(Translate-All-String-Objects Doc)
(bg:layer-status-restore)(vla-endundomark Doc)
(princ)
)

(defun Translate-All-String-Objects (Doc / txtstr tmp txt count)
  (foreach item '("LAYER" "LTYPE" "VIEW" "STYLE" "BLOCK" "UCS" "APPID" "DIMSTYLE" "VPORT")
    (foreach item1 (tablelist  item)
      (if (tblobjname item item1)
      (entmod
      (mapcar '(lambda(pair)
	     (cons (car pair)
		   (if (= (type (cdr pair)) 'STR)
		       (trans-from-rus-to-translit (cdr pair))
		      (cdr pair)
		     )
		   )
	     )
	  (entget(tblobjname item item1))
	  )
      )
        )
      )
    )
(vlax-for Blk	(vla-get-Blocks Doc)
(if (= (vla-get-IsXref Blk) :vlax-false)
(progn
(setq count 0 txt (strcat "Changed " (vla-get-name Blk)))
(grtext -1 txt)
(vlax-for	Obj Blk
(setq count (1+ count))
(if (zerop(rem count 10))(grtext -1 (strcat txt " : " (itoa count))))
(if (and (vlax-write-enabled-p Obj)
         (vlax-property-available-p Obj 'TextString)
) ;_ end of and
(progn
  (entmod
  (mapcar '(lambda(pair)
	     (cons (car pair)
		   (if (= (type (cdr pair)) 'STR)
		       (trans-from-rus-to-translit (cdr pair))
		      (cdr pair)
		     )
		   )
	     )
	  (entget (vlax-vla-object->ename Obj))
	  )
  )
)
) ;_ end of if
) ;_ end of vlax-for
)
) ;_ end of if
) ;_ end of vlax-for
(vl-cmdf "_regenall")
)
(defun trans-from-rus-to-translit ( str / translit)(vl-load-com) 
;;; http://www.caduser.ru/cgi-bin/f1/board.cgi?t=28488Sx
;;; http://forum.dwg.ru/showthread.php?t=13063
;;; Соответствие символов взято с translit.ru
;;; по мотивам http://www.caduser.ru/cgi-bin/f1/board.cgi?t=28488Sx
;;; name - исходная строка 
;;; возвращается преобразованная 
(setq translit 
'(("А" "A")("Б" "B")("В" "B")("Г" "G")("Д" "D")("Е" "E")("І" "I")("К" "K")("М" "M")("Н" "H")("О" "O")("Р" "P")("С" "C")("Т" "T")("Х" "X")("а" "a")("б" "b")("е" "e")("к" "k")("м" "m")("о" "o")("р" "p")("т" "t")("х" "x")("у" "y")("Э" "E")("с" "c"))) 

(apply 'strcat 
(mapcar '(lambda (x / sym) 
(if (setq sym (assoc x translit)) 
(cadr sym) 
x 
) ;_ конец if 
) ;_ конец lambda 
(mapcar 'chr (vl-string->list str)) 
) ;_ конец mapcar 
) ;_ конец apply
)
(defun tablelist (s / d r)
 (while (setq d (tblnext s (null d)))
   (setq r (cons (cdr (assoc 2 d)) r))
)
)
(defun bg:layer-status-restore ()
(foreach item *PD_LAYER_LST*
(if (not (vlax-erased-p (car item)))
(vl-catch-all-apply
'(lambda ()
(vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
(vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of if
) ;_ end of foreach
(setq *PD_LAYER_LST* nil)
) ;_ end of defun

(defun bg:layer-status-save ()
(setq *PD_LAYER_LST* nil)
(vlax-for item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
(setq *PD_LAYER_LST* (cons (list item
(cons "freeze" (vla-get-freeze item))
(cons "lock" (vla-get-lock item))
) ;_ end of cons
*PD_LAYER_LST*
) ;_ end of cons
) ;_ end of setq
(vla-put-lock item :vlax-false)
(if (= (vla-get-freeze item) :vlax-true)
(vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false))))
) ;_ end of vlax-for
) ;_ end of defun

VVA · 16.03.2011, 17:33

У меня сейчас времени разбираться нет. Сделал, как посоветовали в #78

Код:

[Выделить все]

(defun C:R2E ( / *error* Doc)
;;;Rus To Eng
(vl-load-com) 
(defun *error* (msg)(princ msg)
(bg:layer-status-restore)
(vla-endundomark Doc)(princ)
)
(setq Doc (vla-get-activedocument (vlax-get-acad-object)))
(bg:layer-status-save)(vla-startundomark Doc)
(Translate-All-String-Objects Doc)
(bg:layer-status-restore)(vla-endundomark Doc)
(princ)
)

(defun Translate-All-String-Objects (Doc / txtstr tmp txt count)
;;;  (foreach item '("LAYER" "LTYPE" "VIEW" "STYLE" "BLOCK" "UCS" "APPID" "DIMSTYLE" "VPORT")
;;;    (foreach item1 (tablelist  item)
;;;      (if (tblobjname item item1)
;;;      (entmod
;;;      (mapcar '(lambda(pair)
;;;	     (cons (car pair)
;;;		   (if (= (type (cdr pair)) 'STR)
;;;		       (trans-from-rus-to-translit (cdr pair))
;;;		      (cdr pair)
;;;		     )
;;;		   )
;;;	     )
;;;	  (entget(tblobjname item item1))
;;;	  )
;;;      )
;;;        )
;;;      )
;;;    )
(vlax-for Blk	(vla-get-Blocks Doc)
(if (= (vla-get-IsXref Blk) :vlax-false)
(progn
(setq count 0 txt (strcat "Changed " (vla-get-name Blk)))
(grtext -1 txt)
(vlax-for	Obj Blk
(setq count (1+ count))
(if (zerop(rem count 10))(grtext -1 (strcat txt " : " (itoa count))))
(if (and (vlax-write-enabled-p Obj)
         (vlax-property-available-p Obj 'TextString)
) ;_ end of and
(progn
  (entmod
  (mapcar '(lambda(pair)
	     (cons (car pair)
                   (if (and (member (car pair) '(1 3)) (= (type (cdr pair)) 'STR))
		       (trans-from-rus-to-translit (cdr pair))
		      (cdr pair)
		     )
		   )
	     )
	  (entget (vlax-vla-object->ename Obj))
	  )
  )
)
) ;_ end of if
) ;_ end of vlax-for
)
) ;_ end of if
) ;_ end of vlax-for
(vl-cmdf "_regenall")
)
(defun trans-from-rus-to-translit ( str / translit)(vl-load-com) 
;;; http://www.caduser.ru/cgi-bin/f1/board.cgi?t=28488Sx
;;; http://forum.dwg.ru/showthread.php?t=13063
;;; Соответствие символов взято с translit.ru
;;; по мотивам http://www.caduser.ru/cgi-bin/f1/board.cgi?t=28488Sx
;;; name - исходная строка 
;;; возвращается преобразованная 
(setq translit 
'(("А" "A")("Б" "B")("В" "B")("Г" "G")("Д" "D")("Е" "E")("І" "I")("К" "K")("М" "M")("Н" "H")("О" "O")("Р" "P")("С" "C")("Т" "T")("Х" "X")("а" "a")("б" "b")("е" "e")("к" "k")("м" "m")("о" "o")("р" "p")("т" "t")("х" "x")("у" "y")("Э" "E")("с" "c"))) 

(apply 'strcat 
(mapcar '(lambda (x / sym) 
(if (setq sym (assoc x translit)) 
(cadr sym) 
x 
) ;_ конец if 
) ;_ конец lambda 
(mapcar 'chr (vl-string->list str)) 
) ;_ конец mapcar 
) ;_ конец apply
)
(defun tablelist (s / d r)
 (while (setq d (tblnext s (null d)))
   (setq r (cons (cdr (assoc 2 d)) r))
)
)
(defun bg:layer-status-restore ()
(foreach item *PD_LAYER_LST*
(if (not (vlax-erased-p (car item)))
(vl-catch-all-apply
'(lambda ()
(vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
(vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of if
) ;_ end of foreach
(setq *PD_LAYER_LST* nil)
) ;_ end of defun

(defun bg:layer-status-save ()
(setq *PD_LAYER_LST* nil)
(vlax-for item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
(setq *PD_LAYER_LST* (cons (list item
(cons "freeze" (vla-get-freeze item))
(cons "lock" (vla-get-lock item))
) ;_ end of cons
*PD_LAYER_LST*
) ;_ end of cons
) ;_ end of setq
(vla-put-lock item :vlax-false)
(if (= (vla-get-freeze item) :vlax-true)
(vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false))))
) ;_ end of vlax-for
) ;_ end of defun

dpmoucpi · 16.03.2011, 17:44

Но это к сожалению не помогло))

VVA · 16.03.2011, 18:26

dpmoucpi, Из всего чертежа оставь 1 текст, у которого меняет шрифт и 1 текст, у которого меняет знак и выложи этот dwg.

dpmoucpi · 17.03.2011, 10:29

Выяснилось, что если чертёж перед запуском лсп почистить утилитой, то код работает нормально.

VVA · 17.03.2011, 11:09

Цитата:

Сообщение от dpmoucpi

Выяснилось, что если чертёж перед запуском лсп почистить утилитой, то код работает нормально.

Уточни, какая утилита и какой код (номер поста) работает нормально?

dpmoucpi · 17.03.2011, 12:49

проверял код с поста номера 83 и 84. Утилита стандартная автокадовская "Очистить".

VVA · 17.03.2011, 13:06

Добавил purge и audit в #59

dpmoucpi · 18.03.2011, 11:30

Код меняет шрифт и некоторые элементы текста если шрифт в открытом чертеже ариал кир, если обычный ариал то всё нормально.

VVA · 18.03.2011, 12:28

Цитата:

Сообщение от dpmoucpi

Код меняет шрифт и некоторые элементы текста если шрифт в открытом чертеже ариал кир

Открой меню Формат->Тесктовый стиль и найди среди шрифтов Arial Cyr/ (Его нет). Значит, идет подстановка шрифтов (Font Substitution). По умолчанию меняется на simplex. http://forum.dwg.ru/showthread.php?t=59854

dpmoucpi · 18.03.2011, 16:49

Цитата:

Сообщение от VVA

Открой меню Формат->Тесктовый стиль и найди среди шрифтов Arial Cyr/ (Его нет). Значит, идет подстановка шрифтов (Font Substitution). По умолчанию меняется на simplex. http://forum.dwg.ru/showthread.php?t=59854

Он там есть, и если для него поменять шрифт на ариал и запустить лисп то получается как надо.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Ищу СНиП на Английском языке	aibek	Поиск литературы, чертежей, моделей и прочих материалов	2	09.05.2013 04:51
Журналы на английском языке по проектированию зданий и металлических конструкций	nex2hex	Поиск литературы, чертежей, моделей и прочих материалов	0	22.09.2010 11:43
Ищу литературу по деревянным конструкциям на английском языке	Foksolic	Поиск литературы, чертежей, моделей и прочих материалов	9	25.02.2009 17:31
Ищу статью на английском языке 10-12 тысяч слов.	Sherry	Поиск литературы, чертежей, моделей и прочих материалов	2	10.09.2008 10:41
Надписи на чертежах на Украинском языке	sash1222	AutoCAD	1	27.11.2007 12:41

10.12.2010, 11:54
Поиск русских букв в чертежах на английском языке. dpmoucpi Киев Регистрация: 25.11.2010 Сообщений: 29 Добрый день. Появилась такая проблема: Чертежи необходимо сдавать на английском языке. У заказчика установлена система которая проверяет чертежи (вплоть до толщины линии) и если на чертеже есть буквы на русском языке она их не принимает. То-ли в силу своей не внимательности или по другой причине но проектировщики иногда вводят русские буквы вместо английских. Кто может подсказать как бы так находить русские буквы на чертежах?
Просмотров: 21996