Lệnh CHUYENMAFONTDIACHINH
Giúp chuyển đổi mã một số bản vẽ địa chính sửa dụng bảng mã cũ
1 Thêm class CHUYENMAFONTDIACHINH.lsp
Lưu mã sau dưới dạng tệp tin CHUYENMAFONTDIACHINH.lsp
Code:
(defun C:CHUYENMAFONTDIACHINH ( /
ListCodePatternLower
ListCodePatternUpper
ListCodeLower
ListCodeUpper
ListVlaLayerLock
ListVlaObject
ListVarSystem
NameTextStyleConvert
ObjectType
SelectionSet
VlaDrawingCurrent)
(vl-load-com)
(setq VlaDrawingCurrent (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark VlaDrawingCurrent)
(setq ListVarSystem (list (list "CMDECHO" 0) (list "MODEMACRO" "Chuyen ma fon dia chinh...")))
(CMFDC_SET_VARSYSTEM)
(CMFDC_CREATE_LISTVLALAYERLOCK)
(vl-catch-all-apply (function (lambda ( / )
(setq StringChar "abcdefghijklmnopqrstuvwxyz")
(setq ListCodeLower (mapcar 'chr (vl-string->list StringChar)))
(setq ListCodeUpper (mapcar 'chr (vl-string->list (strcase StringChar))))
(setq ListCodePatternLower
(list
(cons "00B8" "00E1") ;; á
(cons "00B5" "00E0") ;; à
(cons "00B6" "1EA3") ;; ả
(cons "00B7" "00E3") ;; ã
(cons "00B9" "1EA1") ;; ạ
(cons "00A8" "0103") ;; ă
(cons "00BE" "1EAF") ;; ắ
(cons "00BB" "1EB1") ;; ằ
(cons "00BC" "1EB3") ;; ẳ
(cons "00BD" "1EB5") ;; ẵ
(cons "00C6" "1EB7") ;; ặ
(cons "00A9" "00E2") ;; â
(cons "00CA" "1EA5") ;; ấ
(cons "00C7" "1EA7") ;; ầ
(cons "00C8" "1EA9") ;; ẩ
(cons "00C9" "1EAB") ;; ẫ
(cons "00CB" "1EAD") ;; ậ
(cons "00D0" "00E9") ;; é
(cons "00CC" "00E8") ;; è
(cons "00CE" "1EBB") ;; ẻ
(cons "00CF" "1EBD") ;; ẽ
(cons "00D1" "1EB9") ;; ẹ
(cons "00AA" "00EA") ;; ê
(cons "00D5" "1EBF") ;; ế
(cons "00D2" "1EC1") ;; ề
(cons "00D3" "1EC3") ;; ể
(cons "00D4" "1EC5") ;; ễ
(cons "00D6" "1EC7") ;; ệ
(cons "00DD" "00ED") ;; í
(cons "00D7" "00EC") ;; ì
(cons "2205" "1EC9") ;; ỉ
(cons "00DC" "0129") ;; ĩ
(cons "00DE" "1ECB") ;; ị
(cons "00E3" "00F3") ;; ó
(cons "00DF" "00F2") ;; ò
(cons "00E1" "1ECF") ;; ỏ
(cons "00E2" "00F5") ;; õ
(cons "00E4" "1ECD") ;; ọ
(cons "00AB" "00F4") ;; ô
(cons "00E8" "1ED1") ;; ố
(cons "00E5" "1ED3") ;; ồ
(cons "00E6" "1ED5") ;; ổ
(cons "00E7" "1ED7") ;; ỗ
(cons "00E9" "1ED9") ;; ộ
(cons "00AC" "01A1") ;; ơ
(cons "00ED" "1EDB") ;; ớ
(cons "00EA" "1EDD") ;; ờ
(cons "00EB" "1EDF") ;; ở
(cons "00EC" "1EE1") ;; ỡ
(cons "00EE" "1EE3") ;; ợ
(cons "00F3" "00FA") ;; ú
(cons "00EF" "00F9") ;; ù
(cons "00F1" "1EE7") ;; ủ
(cons "00F2" "0169") ;; ũ
(cons "00F4" "1EE5") ;; ụ
(cons "00AD" "01B0") ;; ư
(cons "00F8" "1EE9") ;; ứ
(cons "00F5" "1EEB") ;; ừ
(cons "00F6" "1EED") ;; ử
(cons "00F7" "1EEF") ;; ữ
(cons "00F9" "1EF1") ;; ự
(cons "00FD" "00FD") ;; ý
(cons "00FA" "1EF3") ;; ỳ
(cons "00FB" "1EF7") ;; ỷ
(cons "00FC" "1EF9") ;; ỹ
(cons "00FE" "1EF5") ;; ỵ
(cons "00AE" "0111") ;; đ
(cons "00A1" "0102") ;; Ă
(cons "00A2" "00C2") ;; Â
(cons "00A3" "00CA") ;; Ê
(cons "00A4" "00D4") ;; Ô
(cons "00A5" "01A0") ;; Ơ
(cons "00A6" "01AF") ;; Ư
(cons "00A7" "0110") ;; Đ
)
)
(setq ListCodePatternUpper
(list
(cons "00B8" "00C1") ;; Á
(cons "00B5" "00C0") ;; À
(cons "00B6" "1EA2") ;; Ả
(cons "00B7" "00C3") ;; Ã
(cons "00B9" "1EA0") ;; Ạ
(cons "00A8" "0102") ;; Ă
(cons "00BE" "1EAE") ;; Ắ
(cons "00BB" "1EB0") ;; Ằ
(cons "00BC" "1EB2") ;; Ẳ
(cons "00BD" "1EB4") ;; Ẵ
(cons "00C6" "1EB6") ;; Ặ
(cons "00A9" "00C2") ;; Â
(cons "00CA" "1EA4") ;; Ấ
(cons "00C7" "1EA6") ;; Ầ
(cons "00C8" "1EA8") ;; Ẩ
(cons "00C9" "1EAA") ;; Ẫ
(cons "00CB" "1EAC") ;; Ậ
(cons "00D0" "00C9") ;; É
(cons "00CC" "00C8") ;; È
(cons "00CE" "1EBA") ;; Ẻ
(cons "00CF" "1EBC") ;; Ẽ
(cons "00D1" "1EB8") ;; Ẹ
(cons "00AA" "00CA") ;; Ê
(cons "00D5" "1EBE") ;; Ế
(cons "00D2" "1EC0") ;; Ề
(cons "00D3" "1EC2") ;; Ể
(cons "00D4" "1EC4") ;; Ễ
(cons "00D6" "1EC6") ;; Ệ
(cons "00DD" "00CD") ;; Í
(cons "00D7" "00CC") ;; Ì
(cons "2205" "1EC8") ;; Ỉ
(cons "00DC" "0128") ;; Ĩ
(cons "00DE" "1ECA") ;; Ị
(cons "00E3" "00D3") ;; Ó
(cons "00DF" "00D2") ;; Ò
(cons "00E1" "1ECE") ;; Ỏ
(cons "00E2" "00D5") ;; Õ
(cons "00E4" "1ECC") ;; Ọ
(cons "00AB" "00D4") ;; Ô
(cons "00E8" "1ED0") ;; Ố
(cons "00E5" "1ED2") ;; Ồ
(cons "00E6" "1ED4") ;; Ổ
(cons "00E7" "1ED6") ;; Ỗ
(cons "00E9" "1ED8") ;; Ộ
(cons "00AC" "01A0") ;; Ơ
(cons "00ED" "1EDA") ;; Ớ
(cons "00EA" "1EDC") ;; Ờ
(cons "00EB" "1EDE") ;; Ở
(cons "00EC" "1EE0") ;; Ỡ
(cons "00EE" "1EE2") ;; Ợ
(cons "00F3" "00DA") ;; Ú
(cons "00EF" "00D9") ;; Ù
(cons "00F1" "1EE6") ;; Ủ
(cons "00F2" "0168") ;; Ũ
(cons "00F4" "1EE4") ;; Ụ
(cons "00AD" "01AF") ;; Ư
(cons "00F8" "1EE8") ;; Ứ
(cons "00F5" "1EEA") ;; Ừ
(cons "00F6" "1EEC") ;; Ử
(cons "00F7" "1EEE") ;; Ữ
(cons "00F9" "1EF0") ;; Ự
(cons "00FD" "00DD") ;; Ý
(cons "00FA" "1EF2") ;; Ỳ
(cons "00FB" "1EF6") ;; Ỷ
(cons "00FC" "1EF8") ;; Ỹ
(cons "00FE" "1EF4") ;; Ỵ
(cons "00AE" "0110") ;; Đ
(cons "00A1" "0102") ;; Ă
(cons "00A2" "00C2") ;; Â
(cons "00A3" "00CA") ;; Ê
(cons "00A4" "00D4") ;; Ô
(cons "00A5" "01A0") ;; Ơ
(cons "00A6" "01AF") ;; Ư
(cons "00A7" "0110") ;; Đ
)
)
(setq NameTextStyleConvert "Font Chuyen Ma Dia Chinh")
(CMFDC_CREATE_TEXTSTYLE NameTextStyleConvert)
(setq SelectionSet (ssget))
(setq ListVlaObject (CMFDC_CONVERT_SELECTIONSET_TO_LISTVLAOBJECT SelectionSet))
(foreach VlaObject ListVlaObject
(setq CheckConvertUnicode (vlax-ldata-get VlaObject "CHUYEN MA DIA CHINH"))
(if (not CheckConvertUnicode)
(progn
(setq ObjectType (vla-get-ObjectName VlaObject))
(if (or (= ObjectType "AcDbText") (= ObjectType "AcDbMText"))
(progn
(CMFDC_CONVERT_CODE_VLAOBJECT VlaObject)
(vla-put-StyleName VlaObject NameTextStyleConvert)
)
)
(vlax-ldata-put VlaObject "CHUYEN MA DIA CHINH" T)
)
)
)
)))
(CMFDC_RESTORE_LOCK_LAYER)
(CMFDC_RESET_VARSYSTEM)
(vla-endundomark VlaDrawingCurrent)
(princ "Tac gia HNP - lisp.vn chia se lai T2/2026")
(princ)
)
-------------------------------------------------------------------------------------------------------------------
(defun CMFDC_CONVERT_SELECTIONSET_TO_LISTVLAOBJECT ( SelectionSet /
VlaObject
ListVlaObject
Num)
(if SelectionSet
(progn
(setq Num 0)
(repeat (sslength SelectionSet)
(setq VlaObject (vlax-ename->vla-object (ssname SelectionSet Num)))
(setq ListVlaObject (cons VlaObject ListVlaObject))
(setq Num (+ Num 1))
)
)
)
ListVlaObject
)
------------------------------------------------------------------------------------------------------------------
(defun CMFDC_CONVERT_CODE_VLAOBJECT ( VlaObject /
ListStringSub
TextString
TextStringNew)
(setq TextString (CMFDC_VLA_GET_TEXTSTRING VlaObject))
(setq ListStringSub (CMFDC_STRING_TO_LIST_WITH_SPACE_ALL TextString (list " " "\\p" "\\P" "\\t" "\\T")))
(setq TextStringNew (apply 'strcat (mapcar 'CMFDC_CONVERT_CODE_STRINGSUB ListStringSub)))
(vla-put-textstring VlaObject TextStringNew)
)
------------------------------------------------------------------------------------------------------------------
(defun CMFDC_CONVERT_CODE_STRINGSUB ( StringSub /
ListCodeDec
StringSubResult
ValueChangeCase)
(setq ListCodeDec (vl-string->list StringSub))
(setq ValueChangeCase (CMFDC_CHECK_NORMAL_UPPER_LOWER_WORD StringSub))
(setq StringSubResult (apply 'strcat (mapcar '(lambda (x) (CMFDC_CODEDEC_TO_CODEUNI x ValueChangeCase)) ListCodeDec)))
StringSubResult
)
------------------------------------------------------------------------------------------------------------------
(defun CMFDC_CODEDEC_TO_CODEUNI ( CodeDec ValueChangeCase /
CodeHex
CodeUni)
(setq CodeHex (CMFDC_CONVERT_DECIMAL_TO_BASE CodeDec 16))
(repeat (- 4 (strlen CodeHex))
(setq CodeHex (strcat "0" CodeHex))
)
(if (= ValueChangeCase 2)
(setq CodeUni (cdr (assoc CodeHex ListCodePatternUpper)))
(setq CodeUni (cdr (assoc CodeHex ListCodePatternLower)))
)
(if CodeUni
(setq CodeUni (strcat "\\U+" CodeUni))
(progn
(cond
((= ValueChangeCase 0)
(setq CodeUni (chr CodeDec))
)
((= ValueChangeCase 1)
(setq CodeUni (strcase (chr CodeDec) T))
)
((= ValueChangeCase 2)
(setq CodeUni (strcase (chr CodeDec)))
)
)
)
)
CodeUni
)
--------------------------------------------------------------------------------------------------------------------
(defun CMFDC_CONVERT_DECIMAL_TO_BASE ( Num Base /
CharTemp
NumMod
StringNum)
(setq StringNum "")
(while (> Num 0)
(setq NumMod (rem Num Base))
(if (< NumMod 10)
(setq CharTemp (chr (+ NumMod 48)))
(setq CharTemp (chr (+ NumMod 55)))
)
(setq StringNum (strcat CharTemp StringNum))
(setq Num (/ Num Base))
)
(if (= StringNum "")
(setq StringNum "0")
)
StringNum
)
-------------------------------------------------------------------------------------------------------------------
(defun CMFDC_CHECK_NORMAL_UPPER_LOWER_WORD ( TextStringSub /
CharTemp
LengthString
StringTemp
ValueResult)
(setq ValueResult 0)
(setq LengthString (strlen TextStringSub))
(if (> LengthString 0)
(progn
(if (member (substr TextStringSub 1 1) ListCodeLower)
(setq ValueResult 1)
)
)
)
(if (> LengthString 1)
(progn
(setq StringTemp (substr TextStringSub 2))
(while
(and
(/= StringTemp "")
(/= ValueResult 2)
)
(progn
(setq CharTemp (substr StringTemp 1 1))
(if (member CharTemp ListCodeUpper)
(setq ValueResult 2)
)
(setq StringTemp (substr StringTemp 2))
)
)
)
)
ValueResult
)
-------------------------------------------------------------------------------------------------------------------
(defun CMFDC_VLA_GET_TEXTSTRING ( VlaObject / TextString)
(setq TextString (cdr (assoc 1 (reverse (entget (vlax-vla-object->ename VlaObject))))))
)
--------------------------------------------------------------------------------------------------------------------
(defun CMFDC_STRING_TO_LIST_WITH_SPACE_ALL ( Stg ListDel / ListString )
(setq ListString (list Stg))
(foreach Del ListDel
(setq ListString (apply 'append (mapcar '(lambda (x) (CMFDC_STRING_TO_LIST_NO_TRIM_WITH_SPACE x Del)) ListString)))
)
ListString
)
--------------------------------------------------------------------------------------------------------------------
(defun CMFDC_STRING_TO_LIST_NO_TRIM_WITH_SPACE (Stg Del / LenDel StgTemp Pos StgSub StgSubTemp ListString)
(if Stg
(progn
(setq LenDel (strlen Del))
(setq StgTemp Stg)
(while (setq Pos (vl-string-search Del StgTemp))
(setq StgSub (substr StgTemp 1 Pos))
(setq StgTemp (substr StgTemp (+ Pos 1 LenDel)))
(setq StgSubTemp StgSub)
(if (/= StgSubTemp "")
(setq ListString (append ListString (list StgSub Del)))
)
)
(setq StgSub StgTemp)
(setq StgSubTemp StgSub)
(if (/= StgSubTemp "")
(setq ListString (append ListString (list StgSub)))
)
(if (not ListString)
(setq ListString (list Stg))
)
)
)
ListString
)
-------------------------------------------------------------------------------------------------------------------
(defun CMFDC_CREATE_TEXTSTYLE ( NameTextStyleConvert /
Charset
FontBold
FontHeight
FontItalic
FontName
FontWidth
ListDataTextStyle
NameTextStyle
PitchAndFamily
VlaTextStyle
VlaTextStylesGroup)
(setq ListDataTextStyle
(list
(list NameTextStyleConvert "arial" :vlax-false :vlax-false 0.0 1.0 1 0)
)
)
(setq VlaTextStylesGroup (vla-get-textstyles VlaDrawingCurrent))
(foreach DataTextStyle ListDataTextStyle
(setq NameTextStyle (nth 0 DataTextStyle))
(setq FontName (nth 1 DataTextStyle))
(setq FontBold (nth 2 DataTextStyle))
(setq FontItalic (nth 3 DataTextStyle))
(setq FontHeight (nth 4 DataTextStyle))
(setq FontWidth (nth 5 DataTextStyle))
(setq Charset (nth 6 DataTextStyle))
(setq PitchAndFamily (nth 7 DataTextStyle))
(setq VlaTextStyle Nil)
(vl-catch-all-apply (function (lambda ( / )
(setq VlaTextStyle (vla-item VlaTextStylesGroup NameTextStyle))
)))
(if (not VlaTextStyle)
(setq VlaTextStyle (vla-add VlaTextStylesGroup NameTextStyle))
)
(vla-SetFont VlaTextStyle FontName FontBold FontItalic Charset PitchAndFamily)
(vla-put-Height VlaTextStyle FontHeight)
(vla-put-width VlaTextStyle FontWidth)
(CMFDC_PUT_ANNOTATIVE_TEXTSTYLE VlaTextStyle Nil)
(CMFDC_PUT_ORIENTATION_TEXTSTYLE VlaTextStyle Nil)
)
)
-------------------------------------------------------------------------------------------------------------------
(defun CMFDC_PUT_ANNOTATIVE_TEXTSTYLE ( VlaTextStyle ModeAnnotative / EnameTextStyle )
(setq EnameTextStyle (vlax-vla-object->ename VlaTextStyle))
(if ModeAnnotative
(entmod (list (cons -1 EnameTextStyle) (list -3 (list "AcadAnnotative" (cons 1000 "AnnotativeData") (cons 1002 "{") (cons 1070 1) (cons 1070 1) (cons 1002 "}")))))
(entmod (list (cons -1 EnameTextStyle) (list -3 (cons "AcadAnnotative" Nil))))
)
)
-------------------------------------------------------------------------------------------------------------------
(defun CMFDC_PUT_ORIENTATION_TEXTSTYLE ( VlaObject ModeOrientation / EnameTextStyle)
(setq EnameTextStyle (vlax-vla-object->ename VlaObject))
(if ModeOrientation
(entmod (list (cons -1 EnameTextStyle) (list -3 (cons "AcadAnnoPO" (list (cons 1070 1))))))
(entmod (list (cons -1 EnameTextStyle) (list -3 (cons "AcadAnnoPO" Nil))))
)
)
-------------------------------------------------------------------------------------------------------------------
(defun CMFDC_CREATE_LISTVLALAYERLOCK ( / VlaLayersGroup)
(setq VlaLayersGroup (vla-get-layers VlaDrawingCurrent))
(vlax-for VlaLayer VlaLayersGroup
(if
(= (vla-get-Lock VlaLayer) :vlax-true)
(progn
(vla-put-Lock VlaLayer :vlax-false)
(setq ListVlaLayerLock (cons VlaLayer ListVlaLayerLock))
)
)
)
)
-------------------------------------------------------------------------------------------------------------------
(defun CMFDC_RESTORE_LOCK_LAYER ( / )
(foreach VlaLayerLock ListVlaLayerLock
(vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Lock (list VlaLayerLock :vlax-true)))
)
)
-------------------------------------------------------------------------------------------------------------------
(defun CMFDC_SET_VARSYSTEM ( / )
(foreach Temp ListVarSystem
(vl-catch-all-apply (function (lambda ( / )
(setq ListVarSystem (subst (append Temp (list (getvar (nth 0 Temp)))) Temp ListVarSystem))
(setvar (nth 0 Temp) (nth 1 Temp))
)))
)
)
-------------------------------------------------------------------------------------------------------------------
(defun CMFDC_RESET_VARSYSTEM ( / )
(foreach Temp ListVarSystem
(vl-catch-all-apply (function (lambda ( / )
(setvar (nth 0 Temp) (nth 2 Temp))
)))
)
)
Link tải (MediaFire)
---------------------------------------------------------------------------------------------
Mọi thông tin xin liên hệ Fanpage AutoLISP Thật là đơn giản!
Cảm ơn bạn đã theo dõi!
Không có nhận xét nào:
Đăng nhận xét