entmake创建文字样式

小万LISP · 发表于 2019-10-3 15:23:33

(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 15:57:30

本帖最后由 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$) rimary 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
)

(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$)                      <img src="static/image/smiley/default/titter.gif" smilieid="9" border="0" alt="" />rimary 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 
)

sachindkini · 发表于 2019-10-3 16:12:05

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 . "}")
)
)
)
)

小万LISP · 发表于 2019-10-3 16:18:28

sachindkini 发表于 2019-10-3 15:57

感觉还是我的直观好用。

江南十笑 · 发表于 2020-8-11 20:58:58

楼主这个创建不成功啊并没有创建相应字体是什么情况

hubeiwdlue · 发表于 2024-2-12 18:17:53

谢谢楼主分享。

moshouhot · 发表于 2024-4-29 12:15:21

(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 40 0) ;文字高度（必选项）
;(cons 70 0) ;文字效果:0=水平，4=垂直
;(cons 71 4)
; 其他属性可以根据需要添加
)
)
(princ (strcat "文字样式创建成功: " Name)) ; 输出创建成功的消息
)
(princ (strcat "文字样式已存在: " Name)) ; 如果样式已存在，输出消息
)
(princ) ; 清除命令行
)

(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 40  0)                             ;文字高度（必选项） 
          ;(cons 70  0)                           ;文字效果:0=水平，4=垂直 
          ;(cons 71  4)          
          ; 其他属性可以根据需要添加 
        ) 
      ) 
      (princ (strcat "文字样式创建成功: " Name))   ; 输出创建成功的消息 
    ) 
    (princ (strcat "文字样式已存在: " Name))       ; 如果样式已存在，输出消息 
  ) 
  (princ)                                          ; 清除命令行 
)

坠茵落溷 · 发表于 2024-6-4 16:52:45

楼主这个创建不成功，并没有创建相应字体。现在一头雾水。

儒门小客 · 发表于 2024-10-4 20:33:14

请教一下楼主，如何修改已有的字体样式？

陈伟 · 发表于 2024-10-16 16:57:47

本帖最后由陈伟于 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)
)

账号		自动登录	找回密码
密码			注册

[经验] entmake创建文字样式

本帖子中包含更多资源

点评

浏览过的版块