(求助)一键调整文字样式
请问一下论坛的大神们，能不能帮小弟搞一个一键生成文字样式的代码生成的内容如图片（图片上的内容都是调整好的）(defun C:T1()
(X新建文字样式 "standard" "txt.shx" "&万能字体.shx")
)
;新建文字样式 feng582304 2013-1-7
;http://bbs.mjtd.com/forum.php?mod=viewthread&tid=99969&extra=&highlight=%CE%C4%D7%D6%D1%F9%CA%BD&page=1
(defun X新建文字样式(y样式名称 z字体名称 d大字体名称 / obj)
;(vl-cmdf "undo" "be")
(setq obj (vla-add (vla-get-TextStyles (vla-get-ActiveDocument (vlax-get-acad-object))) y样式名称))
(vlax-dump-Object obj)
(if d大字体名称
(progn ;qr,qq1434177703,2020/8/6
(vla-put-fontfile obj z字体名称)
(vla-put-BigFontFile obj d大字体名称)
)
(progn
(setq d大字体名称 "")
(vla-setFont obj z字体名称 :vlax-false :vlax-false 134 2)
)
)
(vla-put-Height obj 500) ;设置字高
(vla-put-Width obj 1) ;设置宽度因子
(vla-put-ActiveTextStyle (vla-get-ActiveDocument (vlax-get-acad-object)) obj) ;设置为当前字体样式
(vl-cmdf "purge" "st" "*" "n" "_regen") ;删除其它文字样式
(princ (strcat "\n 文字样式 " y样式名称 "," z字体名称 "," d大字体名称 " 已建立并置为当前") )
;(vl-cmdf "undo" "e")
(setq y样式名称 nil z字体名称 nil d大字体名称 nil obj nil)
(princ)) 怎么到处求功能 纵横八方 发表于 2020-8-16 16:32
怎么到处求功能
我的想法呢，第一，万一有人刚好有这样的，并且愿意分享呢 第二，每天逛逛论坛，虽然我不会代码，但是我有古怪的想法发表一下，看一下有没有论坛的大神，刚好有兴趣，练一下手，巩固巩固思维的，并且愿意帮助人的大神。 第三，我知道我到处求不花钱，这个事情不好，但是有些功能是可有可无的，我只是想把我想要实现的东西，提出来，参与论坛的积极性，以后，说不定我也学会了，我就可以自己实现了呢 第四，就像一个想法，被其它大神看到了，并且他觉得是个好的想法，他可以在自己的工具箱里实现。 第五，我正好需要，大神正好有，并且愿意提供分享，那对被别人善心帮助的人心底也会有一股暖流。 我说出了我的想法， 我知道，有时候无私的分享和奉献会对爱好，和可以靠代码来赚点零用钱的大神会有损害，在这里对各位大神说一声对不起，这些都是自愿的行为，我没有去强求，而且我这边提出的想法都是一些小功能，，真正那些很厉害的功能碰巧我刚好又非常需要的，我肯定会找人花钱定制的，谢谢你的问题呢，我不想得罪人回复是我自己心里的想法呢，，谢谢 ;新建文字样式 feng582304 2013-1-7
;http://bbs.mjtd.com/forum.php?mod=viewthread&tid=99969&extra=&highlight=%CE%C4%D7%D6%D1%F9%CA%BD&page=1
(defun X新建文字样式(y样式名称 z字体名称 d大字体名称 / obj )
;(vl-cmdf "undo" "be")
(if (not (tblsearch "style" y样式名称))
(progn
(setq obj (vla-add (vla-get-TextStyles (vla-get-ActiveDocument (vlax-get-acad-object))) y样式名称))
(vlax-dump-Object obj)
(if d大字体名称
(progn ;qr,qq1434177703,2020/8/6
(vla-put-fontfile obj z字体名称)
(vla-put-BigFontFile obj d大字体名称)
)
(progn
(setq d大字体名称 "")
(vla-setFont obj z字体名称 :vlax-false :vlax-false 134 2)
)
)
(vla-put-Height obj 0) ;设置字高
(vla-put-Width obj 0.7) ;设置宽度因子
(vla-put-ActiveTextStyle (vla-get-ActiveDocument (vlax-get-acad-object)) obj) ;设置为当前字体样式
(vl-cmdf "purge" "st" "*" "n" "_regen") ;删除其它文字样式
(princ (strcat "\n 文字样式 " y样式名称 "," z字体名称 "," d大字体名称 " 已建立并置为当前") )
)
(progn
(if (not d大字体名称)(setq d大字体名称 ""))
(princ (strcat "\n 文字样式 " y样式名称 "," z字体名称 "," d大字体名称 " 已存在") )
)
)
;(vl-cmdf "undo" "e")
(setq y样式名称 nil z字体名称 nil d大字体名称 nil obj nil)
(princ)) 669423907 发表于 2020-8-17 21:54
;新建文字样式 feng582304 2013-1-7
;http://bbs.mjtd.com/forum.php?mod=viewthread&tid=99969&extra=&hi ...
谢谢大神出手，学习学习 669423907 发表于 2020-8-17 21:54
;新建文字样式 feng582304 2013-1-7
;http://bbs.mjtd.com/forum.php?mod=viewthread&tid=99969&extra=&hi ...
大神，可以有时间帮忙看一下是什么问题吗？出现的问题：命令: T1 ; 错误: 参数太少
(defun C:T1(standardtxt.shx&万能字体.shx / obj )
(vl-cmdf "undo" "be")
(if (not (tblsearch "style" standard))
(progn
(setq obj (vla-add (vla-get-TextStyles (vla-get-ActiveDocument (vlax-get-acad-object))) standard))
(vlax-dump-Object obj)
(if &万能字体.shx
(progn ;qr,qq1434177703,2020/8/6
(vla-put-fontfile obj txt.shx)
(vla-put-BigFontFile obj &万能字体.shx)
)
(progn
(setq &万能字体.shx "")
(vla-setFont objtxt.shx :vlax-false :vlax-false 134 2)
)
)
(vla-put-Height obj 500) ;设置字高
(vla-put-Width obj1) ;设置宽度因子
(vla-put-ActiveTextStyle (vla-get-ActiveDocument (vlax-get-acad-object)) obj) ;设置为当前字体样式
(vl-cmdf "purge" "st" "*" "n" "_regen") ;删除其它文字样式
(princ (strcat "\n 文字样式 " standard ","txt.shx ","&万能字体.shx " 已建立并置为当前") )
)
(progn
(if (not &万能字体.shx)(setqgbcbig.shx ""))
(princ (strcat "\n 文字样式 " standard ","txt.shx ","&万能字体.shx " 已存在") )
)
)
(vl-cmdf "undo" "e")
(setq standard niltxt.shx nil &万能字体.shx nil obj nil)
(princ)) 669423907 发表于 2020-8-17 22:52
(defun C:T1()
(X新建文字样式 "standard" "txt.shx" "&万能字体.shx")
)
运行命令提示：命令: G6
文字样式 standard,txt.shx,&万能字体.shx 已存在
然后请教大神，如何输入命令后，直接切换到设置好的参数呢
(defun C:G6()
(G6"standard" "txt.shx""&万能字体.shx" )
)
(defun G6(standard txt.shx&万能字体.shx / obj)
;(vl-cmdf "undo" "be")
(if (not (tblsearch "style" standard))
(progn
(setq obj (vla-add (vla-get-TextStyles (vla-get-ActiveDocument (vlax-get-acad-object))) standard))
(vlax-dump-Object obj)
(if &万能字体.shx
(progn ;qr,qq1434177703,2020/8/6
(vla-put-fontfile obj txt.shx)
(vla-put-BigFontFile obj &万能字体.shx)
)
(progn
(setq &万能字体.shx "")
(vla-setFont objtxt.shx :vlax-false :vlax-false 134 2)
)
)
(vla-put-Height obj 500) ;设置字高
(vla-put-Width obj1) ;设置宽度因子
(vla-put-ActiveTextStyle (vla-get-ActiveDocument (vlax-get-acad-object)) obj) ;设置为当前字体样式
(vl-cmdf "purge" "st" "*" "n" "_regen") ;删除其它文字样式
(princ (strcat "\n 文字样式 " standard ","txt.shx ","&万能字体.shx " 已建立并置为当前") )
)
(progn
(if (not &万能字体.shx)(setqgbcbig.shx ""))
(princ (strcat "\n 文字样式 " standard ","txt.shx ","&万能字体.shx " 已存在") )
)
)
;(vl-cmdf "undo" "e")
(setq standard niltxt.shx nil &万能字体.shx nil obj nil)
(princ)) 999999 发表于 2020-8-17 22:07
谢谢大神出手，学习学习
那也得谢谢你的热心帮助
页:
[1]