entmake创建文字样式
(defun c:tt(/)
(NewStyle "国标最丑" "gbenor.shx" "gbcbig.shx" 1 0)
(NewStyle "标注样式" "romans.shx" "hzdx.shx" 0.7 15)
(NewStyle "最佳单线" "romans.shx" "hzdx.shx" 0.8 0)
(NewStyle "ttf最卡尽量少用" "simhei.ttf" "" 1 0)
)
;新建文字样式：名称 英文字形 中文字体 宽度比例 倾斜角度
(defun NewStyle(Name EN CN BL JD)
(if (not(tblsearch "style" Name))
(entmake
(list
'(0 . "STYLE")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbTextStyleTableRecord")
(cons 2 Name) ;文字样式名称
(cons 3 EN) ;英文字形
(cons 4 CN) ;中文字体
(cons 41 BL);宽度比例
(cons 50 (*(/ JD 180.0)pi));倾斜角度,需转化为弧度
;'(70 . 0) ;文字效果:0=水平，4=垂直
;'(40 . 0) ;文字高度
;'(71 . 4) ;文字效果：4=颠倒,2=反向,6=颠倒+反向
)
)
)
(princ)
)
需要注意的是在lisp中除法运算符/，参数均为整数时，结果也为整数，比如
(/ 15 180)=0 ，只有写成
(/ 15.0 180) 或者 (/ 15 180.0)结果才为0.0833333
本帖最后由 sachindkini 于 2019-10-3 16:03 编辑
(DEFUN xcreatetextstyle(xname$ xfont$ / res$)
(IF (= nil (TBLSEARCH "STYLE" xname$)) ;If the text style table does not have the text style
(PROGN ;CASE TRUE, do the following
(SETQ res$ ;Create a list of the style properties
(LIST
(CONS 0 "STYLE") ;Entity type
(CONS 100 "AcDbSymbolTableRecord") ;Subclass marker
(CONS 100 "AcDbTextStyleTableRecord") ;Subclass marker
(CONS 2 xname$) ;Style Name
(CONS 70 0) ;Standard flag value
(CONS 40 0) ;Fix text height; 0 if not fixed
(CONS 41 0.75) ;Text width factor
(CONS 50 0) ;Text oblique angle
(CONS 71 0) ;Text generation flags, 0-none, 2-backwards, 4-upsidedown
(CONS 42 0) ;Use last text height
(CONS 3 xfont$) ;Primary font file name (shx)
(CONS 4 "") ;Bigfont file name; blank if none
)
)
(ENTMAKE res$) ;Make the entity
(PRINC ;Report the sucessfull creation of the entity back to the user
(STRCAT
"\nSucessfully created the text style: '"
xname$
"' within the current drawing."
)
)
) ;End case true
(PROGN ;CASE FALSE, do the following
(PRINC ;Report the issue to the user
(STRCAT
"\nText Style: '"
xname$
"' already exists within the current drawing."
)
) ;
) ;End case false
) ;End if
)
annotative Text style
(entmakex
'(
(0 . "STYLE")
(100 . "AcDbSymbolTableRecord")
(100 . "AcDbTextStyleTableRecord")
(2 . "My TEXT")
(70 . 0)
(40 . 2.2);;<- text height
(41 . 1.0)
(50 . 0.0)
(71 . 0)
(42 . 2.2)
(3 . "arial.ttf")
(4 . "")
(-3
("AcadAnnotative"
(1000 . "AnnotativeData")
(1002 . "{")
(1070 . 1)
(1070 . 1)
(1002 . "}")
)
)
)
)
sachindkini 发表于 2019-10-3 15:57
感觉 还是我的直观好用。:lol 楼主这个创建不成功啊 并没有创建相应字体 是什么情况 谢谢楼主分享。 (defun c:tt(/)
(NewStyle "国标最丑" "gbenor.shx" "gbcbig.shx" 1 0)
(NewStyle "标注样式" "romans.shx" "hzdx.shx" 0.7 15)
(NewStyle "最佳单线" "romans.shx" "hzdx.shx" 0.8 0)
(NewStyle "ttf最卡尽量少用" "simhei.ttf" "" 1 0)
)
(defun NewStyle (Name EN CN BL JD / styleData radian)
;Name:文字样式名称 EN:英文字形 CN:中文字体 BL:宽度比例 JD:倾斜角度360°
; 检查STYLE表中是否存在给定的文字样式名称
(setq styleData (tblsearch "STYLE" Name))
(if (not styleData)
(progn
; 计算倾斜角度的弧度值
(setq radian (* (/ JD 180.0) pi))
; 创建新的文字样式记录
(entmake
(list
'(0 . "STYLE") ; 实体类型
'(100 . "AcDbSymbolTableRecord") ; 记录类型
'(100 . "AcDbTextStyleTableRecord") ; 表样式记录类型
(cons 2 Name) ; 文字样式名称
(cons 3 EN) ; 英文字形
(cons 4 CN) ; 中文字体
(cons 41 BL) ; 宽度比例
(cons 50 radian) ; 倾斜角度（弧度）
(cons 400) ;文字高度（必选项）
;(cons 700) ;文字效果:0=水平，4=垂直
;(cons 714)
; 其他属性可以根据需要添加
)
)
(princ (strcat "文字样式创建成功: " Name)) ; 输出创建成功的消息
)
(princ (strcat "文字样式已存在: " Name)) ; 如果样式已存在，输出消息
)
(princ) ; 清除命令行
)
楼主这个创建不成功，并没有创建相应字体。现在一头雾水。 请教一下楼主，如何修改已有的字体样式？ 本帖最后由 陈伟 于 2024-10-16 17:11 编辑
儒门小客 发表于 2024-10-4 20:33
请教一下楼主，如何修改已有的字体样式？
修改已有的文字样式
(defun c:ZTTH (/ doc)
(setq txtname "专用字体")
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vlax-for txtstyle (vla-get-textstyles doc)
(if(vl-string-search txtname (vlax-get-property txtstyle 'Name))
(PROGN
(vla-put-fontfile txtstyle "gbenor.shx")
(vla-put-bigfontfile txtstyle "gbcbig.shx")
)
)
)
(princ)
)
页:
[1]