[求助]：有没有什么办法可以将选取的文字的样式置为当前？

andyhua5240 · 发表于 2006-2-8 23:15:03

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

[FONT=courier new]
(defun c:dds()
(princ "\n*** 将选择的标注的样式置为当前 ***")
(command "dimstyle" "r" "")
(princ)
)
[/FONT]

由于我的屏幕的工具比较多，因为屏幕就相对的小点，想画图方便点，因此就不想要那个样式工具条了。
因此就想用命令来完成当前的标注样式和文字样式。
标注样式我已经完成了，但是文字样式搞不掂，请高手们高抬贵手一救？
程序的思路：图形中有几个文字样式，运行命令后选择其中的一个文字，则那个文字的样式即为当前文字样式。
谢谢！

秋枫 · 发表于 2006-2-8 23:53:08

andyhua5240 决定学LISP啦。偶来支持一把。

[font=courier New]
([color=#0000FF]vl-load-com[/color])
([color=#800040]defun[/color] c:test (/ style e)
([color=#0000FF]setq[/color] e ([color=#0000FF]ssget[/color] [color=#FF00FF]":E:S"[/color] '((0 . [color=#FF00FF]"TEXT,MTEXT"[/color]))))
([color=#0000FF]if[/color] ([color=#0000FF]null[/color] e)
([color=#0000FF]progn[/color]
([color=#0000FF]princ[/color] [color=#FF00FF]"\n必须选文字物体"[/color])
([color=#0000FF]vl-exit-with-error[/color] [color=#FF00FF]""[/color])
)
)
([color=#0000FF]setq[/color] e ([color=#0000FF]ssname[/color] e 0))
([color=#0000FF]setq[/color] style ([color=#0000FF]vla-get-stylename[/color]
(vlax-ename-[color=#0000FF]>[/color]vla-object e)
)
)
([color=#0000FF]command[/color] [color=#FF00FF]"-style"[/color] style)
([color=#0000FF]while[/color] (/= [color=#FF00FF]""[/color] ([color=#0000FF]getvar[/color] [color=#FF00FF]"cmdnames"[/color])) ([color=#0000FF]command[/color] [color=#FF00FF]""[/color]))
([color=#0000FF]princ[/color] [color=#FF00FF]"\n"[/color])
([color=#0000FF]princ[/color] style)
([color=#0000FF]princ[/color] [color=#FF00FF]" 现在是当前文字样式."[/color])
([color=#0000FF]princ[/color])
)
[/font]

[font=courier New] 
([color=#0000FF]vl-load-com[/color]) 
 
([color=#800040]defun[/color] c:test (/ style e) 
  ([color=#0000FF]setq[/color] e ([color=#0000FF]ssget[/color] [color=#FF00FF]"&#58;E&#58;S"[/color] '((0 . [color=#FF00FF]"TEXT&#44;MTEXT"[/color])))) 
  ([color=#0000FF]if[/color] ([color=#0000FF]null[/color] e) 
    ([color=#0000FF]progn[/color] 
      ([color=#0000FF]princ[/color] [color=#FF00FF]"&#92;n必须选文字物体"[/color]) 
      ([color=#0000FF]vl-exit-with-error[/color] [color=#FF00FF]""[/color]) 
    ) 
  ) 
  ([color=#0000FF]setq[/color] e ([color=#0000FF]ssname[/color] e 0)) 
  ([color=#0000FF]setq[/color]    style ([color=#0000FF]vla-get-stylename[/color] 
        (vlax-ename-[color=#0000FF]&gt;[/color]vla-object e) 
          ) 
  ) 
  ([color=#0000FF]command[/color] [color=#FF00FF]"&#45;style"[/color] style) 
  ([color=#0000FF]while[/color] (/= [color=#FF00FF]""[/color] ([color=#0000FF]getvar[/color] [color=#FF00FF]"cmdnames"[/color])) ([color=#0000FF]command[/color] [color=#FF00FF]""[/color])) 
  ([color=#0000FF]princ[/color] [color=#FF00FF]"&#92;n"[/color]) 
  ([color=#0000FF]princ[/color] style) 
  ([color=#0000FF]princ[/color] [color=#FF00FF]" 现在是当前文字样式&#46;"[/color]) 
  ([color=#0000FF]princ[/color]) 
) 
[/font]

aichong · 发表于 2006-2-9 00:08:08

请问楼主：你的标注样式是怎么置为当前的？
还有线形呢？

andyhua5240 · 发表于 2006-2-9 00:28:00

最初由秋枫发布
[B]andyhua5240 决定学LISP啦。偶来支持一把。

[code]
(vl-load-com)

(defun c:test (/ style e)
(setq e ([color... [/B]

谢谢大哥的鼓励和支持！
感动得想哭！

eachy · 发表于 2006-2-9 08:51:32

1 打开CAD的“样式”工具条，包括了字体样式、标注样式等，点选实体，在下拉框中选择即设置当前样式

2 参考晓东工具箱中的文字标注样式设置Lisp

xyp1964 · 发表于 2006-2-9 09:24:33

[FONT=courier new];;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;* GHZX(改换字型)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(DEFUN C:GHZX (/ SS s1 n stx)
;(cmdla0)
(prompt "\n将原有文本的字型改为当前所设字型。")
(princ "\n选择文本 : ")
(while (not (SETQ SS (ssget '((0 . "*TEXT"))))))
(setq s1 (ssname SS 0)
n -1
stx (getvar "textstyle")
)
(princ "\n旧字型为 : ")
(princ (xyp-get-dxf 7 s1))
(princ "\n新字型为 : ")
(princ stx)
(princ "\n稍候 : ")
(while (setq s1 (ssname SS (setq n (1+ n))))
(sub_upd s1 7 stx)
(princ ".")
)
(princ n)
(princ "个改变字型!")
;(cmdla1)
;(PXYP "GHZX (改换字型)")
)
(PXYP "GHZX (改换字型)")[/FONT]

可以试试签名栏下的“文本编辑套件”

雨箭风刀 · 发表于 2006-2-9 10:00:15

[php]

(vl-load-com)
(defun c:celtst (/ style e)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (if (setq ss (ssget ":E:S" '((0 . "TEXT,MTEXT"))))
(progn (setq e (ssname ss 0))
         (setq style (vla-get-stylename (vlax-ename->vla-object e)))
         (vla-put-activetextstyle doc (vla-item (vla-get-textstyles doc) style))
         (princ " 现在是当前文字样式: ")
         (princ style)
)
  )
  (princ)
)[/php]

再来个加强版：）
[php]
;| celtst
功能: 参照文本设当前字型 by 雨箭风刀.2006.2
支持: text;mtext;dim标注;属性;块属性;块内文本、属性、标注实体.
|;
(vl-load-com)
(defun c:celtst (/ doc e o tst tstb)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (if (and (setq e (car (nentsel "\n 设置当前字型,选择参照文字:")))
         (setq o (vlax-ename->vla-object e))
         (wcmatch (vla-get-objectname o) "AcDb*Text,AcDbAttribute*"))
(progn (setq tst(vla-get-stylename o))
         (vla-put-activetextstyle doc (setq tstb (vla-item (vla-get-textstyles doc) tst)))
         (mapcar 'princ
               (list"\n 已设置当前文字样式为: " tst " (" (vla-get-fontfile tstb)";"(vla-get-bigfontfile tstb)")"))
)
(princ "\n　必须选择文字!")
  )
  (princ)
)[/php]

xyp1964 · 发表于 2006-2-9 10:28:54

[FONT=courier new](defun c:test (/ ss)
(if (setq ss (ssget '((0 . "TEXT"))))
(setvar "textstyle" (cdr (assoc 7 (entget (ssname ss 0)))))
)
)[/FONT]

选设字型：
[php];;;选设字型
(defun c:XSZX ()
  (if (and (setq s1 (car (nentsel "\n选择文本: ")))
   (member (cdr (assoc 0 (entget s1))) '("TEXT" "MTEXT"))
   )
(progn
   (setq sty (cdr (assoc 7 (entget s1))))
   (princ "\n当前字型由 ")
   (princ (getvar "textstyle"))
   (princ " 改为 ")
   (princ sty)
   (setvar "textstyle" sty)
)
(princ"\n未选到文本!")
  )
  (princ)
)[/php]

andyhua5240 · 发表于 2006-2-9 13:17:14

谢谢大侠们的帮助！
太感谢了！
经测试，小弟我最后打算用雨箭风刀的加强版程序！
谢谢了！找到我需要的东东了！
谢谢！

斑竹的那个改换字型程序，我试用了，感觉可能有点问题？请斑竹查看一下，虽然源码中只支持text，但是我试了mtext，也支持。但是，不是把文字改为当前的文字样式，而是改成了宋体文字样式，并且新建了一个宋体文字样式！

秋枫 · 发表于 2006-2-9 20:19:10

Andyhua，照理没问题。我在AutoCAD 2006下测试通过的。
难道是版本的原因？

如图：

秋枫 · 发表于 2006-2-9 20:21:39

LSP：（最近真是怪了）

雨箭风刀 · 发表于 2006-2-10 14:22:03

(command "-style" style) 是不是这里的问题？
“－”号

eachy · 发表于 2006-2-11 00:52:43

.style

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

[求助] [求助]：有没有什么办法可以将选取的文字的样式置为当前？

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子