wgij007 发表于 2021-4-19 10:34:22

求帮改一下单行文本样式修改

本帖最后由 wgij007 于 2021-4-20 18:28 编辑

左图是左对齐，文字高度3,修改：以左图字体，以中间为中心，修心中间对齐，文字高度为1，到txt样式。
自己改了一下，搞不好。


(defun c:test(/ sc a b)
(setvar "cmdecho" 0)
(progn
(entmake (list (cons 0 "style")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbTextStyleTableRecord")
(cons 2 "txt")
(cons 70 0)
;(cons 11 pt)
;(cons 40 2.5)
(cons 41 1.0)
(cons 50 0.0)
(cons 710)
;(cons 721)
;(cons 732)
(cons 42 1.0)
(cons 3"txt")
;(cons 4"")
(cons 4"")
)
)
(entget (tblobjname "style" "txt"))
)





wang_cn10 发表于 2021-4-19 10:34:23

代码一
修改组码
(defun c:test1 ( / ss pt ent PtLB PtRT n x )
(while (null (setq ss (ssget ":s" '((0 . "TEXT"))))))
(repeat (setq n (sslength ss))
    (setq ent (entget (ssname ss (setq n (1- n)))))
    (foreach x '((40 . 1.0) (7 . "txt") (72 . 1) (73 . 2))
      (setq ent (subst x (assoc (car x) ent) ent)))
    (vla-GetBoundingBox (vlax-ename->vla-object (ssname ss n)) 'PtLB 'PtRT)
    (setq pt (mapcar '(lambda (x) (* 0.5 x)) (mapcar '+ (vlax-safearray->list PtLB) (vlax-safearray->list PtRT))))
    (setq ent (subst (cons 11 pt) (assoc 11 ent) ent))
    (entmod ent)
   )
(princ)
)

代码二
用ActiveX方法
(defun c:test2 ( / ss pt obj PtLB PtRT n )
(while (null (setq ss (ssget ":s" '((0 . "TEXT"))))))
(repeat (setq n (sslength ss))
    (setq obj (vlax-ename->vla-object (ssname ss (setq n (1- n)))))
    (vla-GetBoundingBox obj 'PtLB 'PtRT)
    (setq pt (mapcar '(lambda (x) (* 0.5 x)) (mapcar '+ (vlax-safearray->list PtLB) (vlax-safearray->list PtRT))))
    (vla-put-Height obj 1)
    (vla-put-Alignment obj 10)
    (vla-put-TextAlignmentPoint obj (vlax-3d-point pt))
    (vla-put-StyleName obj "txt")
   )
(princ)
)

wgij007 发表于 2021-4-20 18:29:16

礼貌性，顶一下。

Bao_lai 发表于 2021-4-20 19:14:03

感觉文字样式跟单行文字对正是不同的概念，不知道是不是我没理解。

wgij007 发表于 2021-4-21 08:20:58

是的，现只是求能改变对齐方式

845245015 发表于 2021-4-21 08:37:02

本帖最后由 845245015 于 2021-4-21 08:46 编辑

(defun c:test (/ pt txt1)
(setvar "cmdecho" 0)
(entmake (list '(0 . "STYLE") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbTextStyleTableRecord")
               (cons 2 "txt") '(70 . 0) (cons 40 250) (cons 41 1) '(3 . "txt") '(41 . 0.7)))
(setq pt (getpoint))
(setq txt1 (getstring "请输入文字"))
(entmake (list '(0 . "TEXT") '(7 . "txt") '(8 . "E-LITE-ASSI") (cons 1 txt1)
                   (cons 10 pt) (cons 11 pt) (cons 40 1) (cons 41 0.7) (cons 62 20) (cons 72 1) (cons 73 2)))
(setvar "cmdecho" 0)
)

Bao_lai 发表于 2021-4-21 08:49:40

wgij007 发表于 2021-4-21 08:20
是的，现只是求能改变对齐方式

应该是要对已经生成的文字处理，而不是还没生成的样式哇。

wgij007 发表于 2021-4-21 19:31:31

Bao_lai 发表于 2021-4-21 08:49
应该是要对已经生成的文字处理，而不是还没生成的样式哇。

是的，对已有的进行修改

wgij007 发表于 2021-4-22 08:21:10

wang_cn10 发表于 2021-4-19 10:34
代码一
修改组码
(defun c:test1 ( / ss pt ent PtLB PtRT n x )


可以了，非常感谢!
页: [1]
查看完整版本: 求帮改一下单行文本样式修改