(XD::Doc:creatDimstyleFrom)由已有标注样式建立新标注样式并设为当前

st788796

1. ;;功能: 由已有标注样式建立新标注样式并设为当前
   
2. ;;参数: OldName --- 源标注样式名，nil 为当前样式
   
3. ;;         NewName --- 新标注样式名
   
4. ;;         lst     --- 新标注样式中需要修改的变量表
   
5. ;;返回值: 新样式名
   
6. (defun XD::Doc:createDimStyleFrom (oldName newName lst / dims ndim)
   
7.   (setq dims (vla-get-dimstyles **XD::Doc**))
   
8.   (if (null oldName)
   
9.     (setq oldName (getvar "dimstyle"))
   
10.   )
    
11.   (if (tblsearch "dimstyle" Newname)
    
12.     (if        lst
    
13.       (progn
    
14.         (setq ndim (vla-item dims newName))
    
15.         (mapcar '(lambda (x) (apply 'setvar x)) lst)
    
16.         (vla-copyfrom ndim **XD::Doc**)
    
17.         (vla-put-activedimstyle **XD::Doc** ndim)
    
18.         newName
    
19.       )
    
20.       (if (/= (strcase (getvar "dimstyle") (strcase newName)))
    
21.         (vla-put-activedimstyle **XD::DOC** (vla-item dims newName))
    
22.       )
    
23.     )
    
24.     (progn (setq ndim (vla-add dims newName))
    
25.            (vla-copyfrom (vla-item dims oldname) ndim)
    
26.            (if lst
    
27.              (progn (mapcar '(lambda (x) (apply 'setvar x)) lst)
    
28.                     (vla-copyfrom ndim **XD::Doc**)
    
29.              )
    
30.            )
    
31.            (vla-put-activedimstyle **XD::Doc** ndim)
    
32.            newName
    
33.     )
    
34.   )
    
35. )
    

;;功能: 由已有标注样式建立新标注样式并设为当前<br /> ;;参数: OldName --- 源标注样式名，nil 为当前样式<br /> ;;         NewName --- 新标注样式名<br /> ;;         lst     --- 新标注样式中需要修改的变量表<br /> ;;返回值: 新样式名<br /> (defun XD::Doc:createDimStyleFrom (oldName newName lst / dims ndim)<br />   (setq dims (vla-get-dimstyles **XD::Doc**))<br />   (if (null oldName)<br />     (setq oldName (getvar "dimstyle"))<br />   )<br />   (if (tblsearch "dimstyle" Newname)<br />     (if        lst<br />       (progn<br />         (setq ndim (vla-item dims newName))<br />         (mapcar '(lambda (x) (apply 'setvar x)) lst)<br />         (vla-copyfrom ndim **XD::Doc**)<br />         (vla-put-activedimstyle **XD::Doc** ndim)<br />         newName<br />       )<br />       (if (/= (strcase (getvar "dimstyle") (strcase newName)))<br />         (vla-put-activedimstyle **XD::DOC** (vla-item dims newName))<br />       )<br />     )<br />     (progn (setq ndim (vla-add dims newName))<br />            (vla-copyfrom (vla-item dims oldname) ndim)<br />            (if lst<br />              (progn (mapcar '(lambda (x) (apply 'setvar x)) lst)<br />                     (vla-copyfrom ndim **XD::Doc**)<br />              )<br />            )<br />            (vla-put-activedimstyle **XD::Doc** ndim)<br />            newName<br />     )<br />   )<br /> )<br />

qxlonmsn

好程序   就要支持    非常有用    感谢分享

qxlonmsn

支撑  超级赞

tigcat

是回复可见吗?帖子都看不到了啊