马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×

- ;;;--------------------程序名:装饰施工图引线标注程序--------------------;;;
- ;;;----------------------依据:公司图纸规范编制要求----------------------;;;
- ;;;用法:根据图纸的出图比例和行业的有关规定确定不同出图比例下的引线的设置;;;
- ;;;---------------------制作:SNSJ-----apple_yl.lsp----------------------;;;
- (defun c:yl (/ apple_get_dimsc apple_getdoc apple_addtx tsty apple_dimst_add
- apple_getpt apple_getpt1 apple_getpt2 apple_odv apple_odv1
- apple_odv2 apple_odv3 apple_txtsiz apple_getold_dmst)
- (vl-load-com)
- (setq apple_odv (getvar "Dimtxsty")
- apple_odv1 (getvar "CLAYER")
- apple_odv2 (getvar "Textstyle")
- apple_odv3 (getvar "Dimtxt")
- )
- ;;;设定系统变量原始值;;;
- (if (null apple_oldnb)
- (setq apple_oldnb 100)
- )
- (initget (+ 2 4))
- (setq apple_get_dimsc (getint(strcat "\n请输入图纸的出图比例 <1:" (rtos apple_oldnb 2 0) "> 1:")
- )
- )
- (if (not apple_get_dimsc)
- (setq apple_get_dimsc apple_oldnb)
- (setq apple_oldnb apple_get_dimsc)
- )
- ;;;输入出图比例(记忆上次输入值);;;
- (setq apple_getdoc
- (vla-get-ActiveDocument (vlax-get-acad-object))
- )
- (vla-put-color
- (vla-add
- (vla-get-layers apple_getdoc)
- "apple_qld_layer"
- )
- 3
- )
- ;;;生成引线专用的图层;;;
- (setq apple_addtxtsty
- (vla-add
- (vla-get-Textstyles apple_getdoc)
- "apple_tools_text"
- )
- )
- (vla-put-fontfile apple_addtxtsty "SIMFANG.TTF")
- (vla-put-Height apple_addtxtsty 0)
- ;;;增加一个文字样式,设置字体高度和文字类型,供标注样式调用;;;
- (setq apple_dimst_add
- (vla-add
- (vla-get-dimstyles apple_getdoc)
- "apple-red-qld")
- )
- (setq apple_getold_dmst
- (vla-get-ActiveDimStyle apple_ge tdoc)
- )
- (vla-put-ActiveDimStyle
- apple_getdoc apple_dimst_add
- )
- (setvar "Dimtxsty" "apple_tools_text")
- ;;;增加一个标注样式,将标注的文字样式设为新增加的字体;;;
- (setvar "Dimasz" apple_get_dimsc)
- (setvar "Dimldrblk" "dot")
- (setq apple_txtsiz (* apple_get_di msc 3.5)
- )
- (setvar "Dimtxt" apple_txtsiz)
- (setvar "Clayer" "apple_qld_layer")
- ;;;设置当前图层;;;
- (setq apple_getpt (getpoint "\n点取引线的起点:")
- apple_getpt1 (getpoint apple_getpt "\n点取第二点:")
- apple_getpt2 (getpoint apple_get pt1 "\n点取下一点:")
- )
- (cond
- ((null apple_getpt2)
- (setq apple_getpt2 apple_getpt1)
- (vl-cmdf ".qleader" apple_getpt apple_getpt1 apple_getpt2 "" "0" "")
- )
- (t
- (vl-cmdf ".qleader" apple_getpt apple_getpt 1 apple_getpt2 "0" "")
- )
- )
- ;;;建立新的标注样式,并设置点标,不同比例点标的尺寸;;;
- (vla-put-ActiveDimStyle apple_getdoc apple_getold_dmst )
- (setenv "Dimtxsty" apple_odv)
- (setvar "CLAYER" apple_odv1)
- (setvar "Textstyle" apple_odv 2)
- (setvar "Dimtxt" apple_odv3)
- (princ)
- )
- ;;;--------结束---------;;;
程序源文件下载:
http://www.xdcad.net/forum/attachment.php?postid=493595
使用时请将国标宋体文字从系统文字目录拷贝到CAD搜索路径内的目录里(如CAD里的FONT文件夹内) |