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

lucas3 · 发表于 2014-1-16 19:40:07

本帖最后由 lucas3 于 2014-1-16 19:47 编辑

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

想用lisp新建一个文字样式同标注样式，详情如下：
1.建立一个名为“GB孔”的文字样式，如果下图所示，SHX字体一定要为gdt.shx
forum.php?mod=attachment&aid=NzU3OHwzYWE3YzkyZnwxMzg5ODcyNTI0fDcyNTQwNnw2NzIzODc%3D.gif

forum.php?mod=attachment&aid=NzU3OHwzYWE3YzkyZnwxMzg5ODcyNTI0fDcyNTQwNnw2NzIzODc%3D.gif

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

forum.php?mod=attachment&aid=NzU3OXw0ZTg1MzFiOHwxMzg5ODcyNTI0fDcyNTQwNnw2NzIzODc%3D.gif

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

forum.php?mod=attachment&aid=NzU4MHwxY2NmODRjN3wxMzg5ODcyNTI0fDcyNTQwNnw2NzIzODc%3D.gif

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

forum.php?mod=attachment&aid=NzU4MXw1NDMyMThkY3wxMzg5ODcyNTI0fDcyNTQwNnw2NzIzODc%3D.gif

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

forum.php?mod=attachment&aid=NzU4Mnw2YjA3YjEwMnwxMzg5ODcyNTI0fDcyNTQwNnw2NzIzODc%3D.gif

文字对齐设为ISO标准

forum.php?mod=attachment&aid=NzU4M3xkNmViZGU5MnwxMzg5ODcyNTI0fDcyNTQwNnw2NzIzODc%3D.gif

好了，标注样式设置完了

forum.php?mod=attachment&aid=NzU4NHw0YTYwODg0OHwxMzg5ODcyNTI0fDcyNTQwNnw2NzIzODc%3D.gif

st788796 · 发表于 2014-1-16 19:40:08

标注变量没有修改

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

st788796 · 发表于 2014-1-17 01:25:22

本帖最后由 st788796 于 2014-1-17 08:20 编辑

command有什么问题？

lucas3 · 发表于 2014-1-17 15:21:13

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

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

lucas3 · 发表于 2014-1-17 20:06:09

有谁会吗?帮帮我好么？

st788796 · 发表于 2014-1-17 20:21:47

本帖最后由 st788796 于 2014-1-17 20:23 编辑

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

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

lucas3 · 发表于 2014-1-17 21:25:09

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

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

aeo · 发表于 2014-1-18 00:16:28

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

lucas3 · 发表于 2014-1-18 14:54:08

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

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

本帖最后由 st788796 于 2014-1-18 17:47 编辑

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

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

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

lucas3 · 发表于 2014-1-18 22:04:42

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

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

输入DDIM查看标注样式

st788796 · 发表于 2014-1-19 08:34:22

本帖最后由 st788796 于 2014-1-19 08:43 编辑

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

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

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

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

应用

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

l18c19 · 发表于 2014-1-25 14:26:33

好方法，值得借鉴！

wxa123wl · 发表于 2014-2-12 23:52:51

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

wangxf888 · 发表于 2016-5-24 17:27:48

做个记号用的上

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

[已解决] 用LISP 建立一个文字样式同标注样式

最佳答案

相关帖子

点评