用LISP 建立一个文字样式同标注样式

lucas3

解决问题后 这里的 80豆一并送出 http://bbs.xdcad.net/thread-672387-1-1.html

想用lisp新建一个文字样式同标注样式，详情如下：
1.建立一个名为“GB孔”的文字样式，如果下图所示，SHX字体一定要为gdt.shx


2.建立一个名为“GB孔”的标注样式，如下图

基线间距高为7，超出尺寸线设为2.25 ，起点偏移量设为2

标注文字样试设为先建立的“GB孔”文字高度为2.5

接着建立一个直径标注的子样式，如下

文字对齐设为ISO标准

好了，标注样式设置完了

st788796

标注变量没有修改

1. (command ".-style" "Gdt" "gdt.shx,gbcbig.shx" 0 1.0 0 "n" "n" "n")
   
2. (defun MkDimStyleFrom (OldName NewName / dims ndim)
   
3.   (setq dims (vla-get-dimstyles
   
4.         (vla-get-activedocument (vlax-get-acad-object))
   
5.       )
   
6.   )
   
7.   (if (tblsearch "dimstyle" oldname)
   
8.     (progn
   
9.       (if (not (tblsearch "DimStyle" newName))
   
10. (setq ndim (vla-add dims newName))
    
11.       )
    
12.       (vla-copyfrom (vla-item dims oldname) ndim)
    
13.       (vla-put-activedimstyle dims ndim)
    
14.     )
    
15.   )
    
16. )
    
17. ;;$2 角度标注，$3直径标注，$4 半径标注，$6 坐标标注
    
18. (defun mksubdimsty (name mod / dims)
    
19.   (setq dims (vla-get-dimstyles
    
20.         (vla-get-activedocument (vlax-get-acad-object))
    
21.       )
    
22.   )
    
23.   (if (not (tblsearch "dimstyle" name))
    
24.     (progn
    
25.       (vla-put-activedocument dims (vla-item dims name))
    
26.       (vl-cmdf ".dimstyle" "s" (strcat (getvar "dimstyle") mod))
    
27.     )
    
28.   )
    
29.   (princ)
    
30. )

(command ".-style" "Gdt" "gdt.shx,gbcbig.shx" 0 1.0 0 "n" "n" "n")<br /> (defun MkDimStyleFrom (OldName NewName / dims ndim)<br />   (setq dims (vla-get-dimstyles<br />         (vla-get-activedocument (vlax-get-acad-object))<br />       )<br />   )<br />   (if (tblsearch "dimstyle" oldname)<br />     (progn<br />       (if (not (tblsearch "DimStyle" newName))<br /> (setq ndim (vla-add dims newName))<br />       )<br />       (vla-copyfrom (vla-item dims oldname) ndim)<br />       (vla-put-activedimstyle dims ndim)<br />     )<br />   )<br /> )<br /> ;;$2 角度标注，$3直径标注，$4 半径标注，$6 坐标标注<br /> (defun mksubdimsty (name mod / dims)<br />   (setq dims (vla-get-dimstyles<br />         (vla-get-activedocument (vlax-get-acad-object))<br />       )<br />   )<br />   (if (not (tblsearch "dimstyle" name))<br />     (progn<br />       (vla-put-activedocument dims (vla-item dims name))<br />       (vl-cmdf ".dimstyle" "s" (strcat (getvar "dimstyle") mod))<br />     )<br />   )<br />   (princ)<br /> )

st788796

command有什么问题？

lucas3

st788796 发表于 2014-1-17 12:00
标注变量没有修改

大师谢谢你，我不知道怎么调用你自定义的这些函数

lucas3

有谁会吗?帮帮我好么？

st788796

lucas3 发表于 2014-1-17 20:06
有谁会吗?帮帮我好么？

问了半天你不懂啊？！
不会用就用命令建好直接用

lucas3

st788796 发表于 2014-1-17 20:21
问了半天你不懂啊？！
不会用就用命令建好直接用

大师，你就帮人帮到底，万分感谢

aeo

直接开一个空dwg，自己用cad命令全部建好，存。
需要的时候直接插入那dwg就可以了.
(command "insert" "dwgname")(command)
对不懂lisp的人最方便的方法。而且win7有的ttc文字只能用cad命令。

lucas3

谢谢在这里回复的每一位朋友，谢谢你们的热心帮助，已有朋友帮我解决了此问题，用的是entmakex

st788796

lucas3 发表于 2014-1-18 14:54
谢谢在这里回复的每一位朋友，谢谢你们的热心帮助，已有朋友帮我解决了此问题，用的是entmakex

1. (command ".-style"    "GB孔"           "gdt.shx,gbcbig.shx"
   
2.          0              1.0           0                "n"
   
3.          "n"              "n"
   
4.         )
   
5. 
   
6. (defun MkDimStyleFrom (OldName NewName lst / dims ndim)
   
7.   (setq        dims (vla-get-dimstyles
   
8.                (vla-get-activedocument (vlax-get-acad-object))
   
9.              )
   
10.   )
    
11.   (if (tblsearch "dimstyle" oldname)
    
12.     (progn
    
13.       (if (not (tblsearch "DimStyle" newName))
    
14.         (setq ndim (vla-add dims newName))
    
15.       )
    
16.       (vla-copyfrom (vla-item dims oldname) ndim)
    
17.       (vla-put-activedimstyle
    
18.         (vla-get-activedocument (vlax-get-acad-object))
    
19.         ndim
    
20.       )
    
21.       (if lst
    
22.         (progn
    
23.           (mapcar '(lambda (x) (apply 'setvar x)) lst)
    
24.           (vl-cmdf ".dimstyle" "s" NewName "Y")
    
25.         )
    
26.       )
    
27.     )
    
28.   )
    
29. )
    
30. ;;$2 角度标注，$3直径标注，$4 半径标注，$6 坐标标注
    
31. (defun mksubdimsty (name mod lst / dims)
    
32.   (setq        dims (vla-get-dimstyles
    
33.                (vla-get-activedocument (vlax-get-acad-object))
    
34.              )
    
35.   )
    
36.   (if (tblsearch "dimstyle" name)
    
37.     (progn
    
38.       (vla-put-activedimstyle
    
39.         (vla-get-activedocument (vlax-get-acad-object))
    
40.         (vla-item dims name)
    
41.       )
    
42.       (vl-cmdf ".dimstyle" "s" (strcat (getvar "dimstyle") mod))
    
43.       (if lst
    
44.         (progn
    
45.           (mapcar '(lambda (x) (apply 'setvar x)) lst)
    
46.           (vl-cmdf ".dimstyle"
    
47.                    "s"
    
48.                    (strcat (getvar "dimstyle") mod)
    
49.                    "y"
    
50.           )
    
51.         )
    
52.       )
    
53.     )
    
54.   )
    
55.   (princ)
    
56. )
    
57. 
    
58. 
    
59. (MkDimStyleFrom
    
60.   "ISO-25"
    
61.   "GB孔"
    
62.   '(("DIMDLI" 7.) ("DIMEXE" 2.25) ("DIMEXO" 2.) ("DIMTXT" 2.5))
    
63. )
    
64. (mksubdimsty
    
65.   "GB孔"
    
66.   "$4"
    
67.   '(("dimtoh" "on") ("dimtih" "off"))
    
68. )

(command ".-style"    "GB孔"           "gdt.shx,gbcbig.shx"<br />          0              1.0           0                "n"<br />          "n"              "n"<br />         )<br /> <br /> (defun MkDimStyleFrom (OldName NewName lst / dims ndim)<br />   (setq        dims (vla-get-dimstyles<br />                (vla-get-activedocument (vlax-get-acad-object))<br />              )<br />   )<br />   (if (tblsearch "dimstyle" oldname)<br />     (progn<br />       (if (not (tblsearch "DimStyle" newName))<br />         (setq ndim (vla-add dims newName))<br />       )<br />       (vla-copyfrom (vla-item dims oldname) ndim)<br />       (vla-put-activedimstyle<br />         (vla-get-activedocument (vlax-get-acad-object))<br />         ndim<br />       )<br />       (if lst<br />         (progn<br />           (mapcar '(lambda (x) (apply 'setvar x)) lst)<br />           (vl-cmdf ".dimstyle" "s" NewName "Y")<br />         )<br />       )<br />     )<br />   )<br /> )<br /> ;;$2 角度标注，$3直径标注，$4 半径标注，$6 坐标标注<br /> (defun mksubdimsty (name mod lst / dims)<br />   (setq        dims (vla-get-dimstyles<br />                (vla-get-activedocument (vlax-get-acad-object))<br />              )<br />   )<br />   (if (tblsearch "dimstyle" name)<br />     (progn<br />       (vla-put-activedimstyle<br />         (vla-get-activedocument (vlax-get-acad-object))<br />         (vla-item dims name)<br />       )<br />       (vl-cmdf ".dimstyle" "s" (strcat (getvar "dimstyle") mod))<br />       (if lst<br />         (progn<br />           (mapcar '(lambda (x) (apply 'setvar x)) lst)<br />           (vl-cmdf ".dimstyle"<br />                    "s"<br />                    (strcat (getvar "dimstyle") mod)<br />                    "y"<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br /> <br /> <br /> (MkDimStyleFrom<br />   "ISO-25"<br />   "GB孔"<br />   '(("DIMDLI" 7.) ("DIMEXE" 2.25) ("DIMEXO" 2.) ("DIMTXT" 2.5))<br /> )<br /> (mksubdimsty<br />   "GB孔"<br />   "$4"<br />   '(("dimtoh" "on") ("dimtih" "off"))<br /> )

lucas3

st788796 发表于 2014-1-18 17:44

st788796 您好，再次感谢你，虽然他人帮忙解决了，还是拿你写的这个代码测试了一下，显示  <错误: AutoCAD 变量设置被拒绝: "dimtoh" "on">，我加载 了晓东的LISP函数库同API后，再次测试，显示 <错误: ActiveX 服务器返回错误: 非选择性的参数。>

输入DDIM查看标注样式

st788796

lucas3 发表于 2014-1-18 22:04
st788796 您好，再次感谢你，虽然他人帮忙解决了，还是拿你写的这个代码测试了一下，显示  ，我加载 了晓 ...

给大家提供一种思路和通用方法

1. ;;功能: 由已有标注样式建立新标注样式
   
2. ;;参数: OldName --- 源标注样式名
   
3. ;;      NewName --- 新标注样式名
   
4. ;;      lst     --- 新标注样式中需要修改的变量表
   
5. (defun MkDimStyleFrom (OldName NewName lst / dims ndim)
   
6.   (setq        dims (vla-get-dimstyles
   
7.                (vla-get-activedocument (vlax-get-acad-object))
   
8.              )
   
9.   )
   
10.   (if (and (tblsearch "dimstyle" oldname)
    
11.            (not (tblsearch "dimstyle" Newname))
    
12.       )
    
13.     (progn
    
14.       (setq ndim (vla-add dims newName))
    
15.       (vla-copyfrom (vla-item dims oldname) ndim)
    
16.       (vla-put-activedimstyle
    
17.         (vla-get-activedocument (vlax-get-acad-object))
    
18.         ndim
    
19.       )
    
20.       (if lst
    
21.         (progn
    
22.           (mapcar '(lambda (x) (apply 'setvar x)) lst)
    
23.           (vl-cmdf ".dimstyle" "s" NewName "Y")
    
24.         )
    
25.       )
    
26.     )
    
27.   )
    
28. )
    
29. ;;功能: 由已有标注样式建立新子标注样式
    
30. ;;参数: name ---- 父标注样式
    
31. ;;      mod  ---- 子标注类型
    
32. ;;                $2 角度标注，$3直径标注，$4 半径标注，$6 坐标标注
    
33. ;;      lst  ---- 子标注样式需要修改的系统变量表
    
34. (defun mksubdimsty (name mod lst / dims nname)
    
35.   (setq        dims (vla-get-dimstyles
    
36.                (vla-get-activedocument (vlax-get-acad-object))
    
37.              )
    
38.   )
    
39.   (if (and (tblsearch "dimstyle" name)
    
40.            (setq nname (strcat name mod))
    
41.            (not (tblsearch "dimstyle" nname))
    
42.       )
    
43.     (progn
    
44.       (vla-put-activedimstyle
    
45.         (vla-get-activedocument (vlax-get-acad-object))
    
46.         (vla-item dims name)
    
47.       )
    
48.       (vl-cmdf ".dimstyle" "s" nname)
    
49.       (if lst
    
50.         (progn
    
51.           (mapcar '(lambda (x) (apply 'setvar x)) lst)
    
52.           (vl-cmdf ".dimstyle"  "s" nname  "y")
    
53.         )
    
54.       )
    
55.     )
    
56.   )
    
57.   (princ)
    
58. )

;;功能: 由已有标注样式建立新标注样式<br /> ;;参数: OldName --- 源标注样式名<br /> ;;      NewName --- 新标注样式名<br /> ;;      lst     --- 新标注样式中需要修改的变量表<br /> (defun MkDimStyleFrom (OldName NewName lst / dims ndim)<br />   (setq        dims (vla-get-dimstyles<br />                (vla-get-activedocument (vlax-get-acad-object))<br />              )<br />   )<br />   (if (and (tblsearch "dimstyle" oldname)<br />            (not (tblsearch "dimstyle" Newname))<br />       )<br />     (progn<br />       (setq ndim (vla-add dims newName))<br />       (vla-copyfrom (vla-item dims oldname) ndim)<br />       (vla-put-activedimstyle<br />         (vla-get-activedocument (vlax-get-acad-object))<br />         ndim<br />       )<br />       (if lst<br />         (progn<br />           (mapcar '(lambda (x) (apply 'setvar x)) lst)<br />           (vl-cmdf ".dimstyle" "s" NewName "Y")<br />         )<br />       )<br />     )<br />   )<br /> )<br /> ;;功能: 由已有标注样式建立新子标注样式<br /> ;;参数: name ---- 父标注样式<br /> ;;      mod  ---- 子标注类型<br /> ;;                $2 角度标注，$3直径标注，$4 半径标注，$6 坐标标注<br /> ;;      lst  ---- 子标注样式需要修改的系统变量表<br /> (defun mksubdimsty (name mod lst / dims nname)<br />   (setq        dims (vla-get-dimstyles<br />                (vla-get-activedocument (vlax-get-acad-object))<br />              )<br />   )<br />   (if (and (tblsearch "dimstyle" name)<br />            (setq nname (strcat name mod))<br />            (not (tblsearch "dimstyle" nname))<br />       )<br />     (progn<br />       (vla-put-activedimstyle<br />         (vla-get-activedocument (vlax-get-acad-object))<br />         (vla-item dims name)<br />       )<br />       (vl-cmdf ".dimstyle" "s" nname)<br />       (if lst<br />         (progn<br />           (mapcar '(lambda (x) (apply 'setvar x)) lst)<br />           (vl-cmdf ".dimstyle"  "s" nname  "y")<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

应用

2. 
   
3. (MkDimStyleFrom
   
4.   "ISO-25"
   
5.   "GB孔"
   
6.   '(("DIMTXSTY" "GB孔")
   
7.     ("DIMDLI" 7.)
   
8.     ("DIMEXE" 2.25)
   
9.     ("DIMEXO" 2.)
   
10.     ("DIMTXT" 2.5)
    
11.    )
    
12. )
    
13. 
    
14. (mksubdimsty
    
15.   "GB孔"
    
16.   "$4"
    
17.   '(("DIMTOH" 1) ("DIMTIH" 0))
    
18. )

<br /> (MkDimStyleFrom<br />   "ISO-25"<br />   "GB孔"<br />   '(("DIMTXSTY" "GB孔")<br />     ("DIMDLI" 7.)<br />     ("DIMEXE" 2.25)<br />     ("DIMEXO" 2.)<br />     ("DIMTXT" 2.5)<br />    )<br /> )<br /> <br /> (mksubdimsty<br />   "GB孔"<br />   "$4"<br />   '(("DIMTOH" 1) ("DIMTIH" 0))<br /> )

l18c19

好方法，值得借鉴！

wxa123wl

你把样式，线性，，图层，标注样式什么都建立好，，另存为模板图，，dwt的，那个，，，覆盖acad，dwt，然后op---------文件-----------样板设置-------------快速新建默认样板名------把刚保存的那个acad。dwt放进去，，，应用，保存，，，以后每次打开图纸都有你要的那些样式什么的，，，，，，，，还有你要是不想覆盖默认的acad，样板文件，也可以不存那个名字，，，，别的也可以，，但是要把你存的文件盒acad，dwt，，放在同一个文件夹下面，，

wangxf888

做个记号  用的上