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

wgij007

左图是左对齐，文字高度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 71  0)
;(cons 72  1)
;(cons 73  2)
(cons 42 1.0)
(cons 3  "txt")
;(cons 4  "")
(cons 4  "")
)
)
(entget (tblobjname "style" "txt"))
)

wang_cn10

代码一
修改组码
(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

礼貌性，顶一下。

Bao_lai

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

wgij007

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

845245015

(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

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

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

wgij007

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

是的，对已有的进行修改

wgij007

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

可以了，非常感谢!