牛仔key
发表于 2012-10-16 10:09:09
可以的没这么多的钱下载了,但是还是要支持下的
crazylsp
发表于 2012-10-17 11:51:32
我把黄大侠的收集成果文章粘到word里添加了目录,方便查询。
etoxp
发表于 2012-10-18 20:37:11
下下来看看
自贡黄明儒
发表于 2012-10-23 14:36:07
;;152.1 [功能] 局部重生
;;152.2 [功能] 局部重生
;;153.1 [功能] 注册应用程序名的选择集
;;153.2 [功能] 一个图元的扩展数据列表
;;153.3 [功能] 一个图元的扩展数据列表(无注册应用程序名)
;;153.4 [功能] 一个图元的扩展数据列表
;;154.1 [功能] 获取ObjectDBX版本字符串
;;154.2 [功能] dwg转dxf文件函数
;;154.3 [功能] 将文件存为2K格式,并去教育版
;;154.4 [功能] 将文件以Wblock输出,并去教育版(文件名不变)
;;154.5 [功能] 打开的文件以Wblock输出,并去教育版(除激活的文档外,文件名不变)
;;154.6 [功能] 打开的文件全部Wblock输出
;;152.1 [功能] 局部重生 by Lee Mac
;;示例 (MJ:Update (entget (car (entsel))))
(defun MJ:Update (enlist)
(entupd (cdr (assoc -1 enlist)))
)
;;152.2 [功能] 局部重生
;;示例(MJ:RedrawSS (ssget))
(defun MJ:RedrawSS (ss)
(
(lambda (i)
(while (setq e (ssname ss (setq i (1+ i))))
(entupd e)
)
)
-1
)
)
;;153.1 [功能] 注册应用程序名的选择集
(defun ssget-app (rname)
(ssget "X" (list (list -3 (list rname))))
)
;;153.2 [功能] 一个图元的扩展数据列表
;;示例 (get-eedlist-all (car (entsel)))
(defun get-eedlist-all (ent)
(cdadr (assoc -3 (entget ent) '("*"))))
)
;;153.3 [功能] 一个图元的扩展数据列表(无注册应用程序名)
(defun getxdata-all (e apnlst)
(apply 'append (mapcar 'cdr (getxdata e apnlst)))
)
;;153.4 [功能] 一个图元的扩展数据列表
(defun getxdata (e apnlst)
(cdr (assoc -3 (entget e apnlst)))
)
;;154.1 [功能] 获取ObjectDBX版本字符串
;;用于操作非打开文件
(defun GetObjectDBXVer (/ VERSION)
(if (>= (setq VERSION (atoi (getvar "acadver"))) 16)
(strcat "ObjectDBX.AxDbDocument." (itoa VERSION))
)
)
;;154.2 [功能] dwg转dxf文件函数
;;非打开文件
(defun Dwg2Dxf (DwgName dxfName / dbxDoc)
(setq dbxDoc (vla-GetInterfaceObject
(vlax-get-acad-object)
(GetObjectDBXVer)
)
)
(vla-open dbxDoc DwgName) ;不能打开.dxf文件
(vlax-invoke dbxDoc "dxfout" dxfName)
(if dbxDoc
(vlax-release-object dbxDoc)
) ;关闭文档,用(vla-close dbxDoc :vlax-false)行不通?
)
;;154.3 [功能] 将文件存为2K格式,并去教育版(文件名不变)
;;非打开的文件
;;(DwgOut "D:\\Drawing1.dwg")
(defun DwgOut (DwgName / BACKUPFILE BASENAME DOCOBJ DXFFILE FILEPATH)
;;1 获取全路径,即路径后有
(defun GetFullPath (path)
(if (wcmatch path "*\\")
path
(strcat path "\\")
)
)
;;2 能删除所有文件,不管只读、隐藏与否,都能删除
(defun DeleteFile (FIL / FILSYS FILDIR SS ENT)
(setq FILSYS (vlax-create-object "Scripting.FileSystemObject"))
(setq FILDIR (vl-filename-directory FIL))
(setq
SS (vl-directory-files
FILDIR
(strcat (vl-filename-base FIL) (vl-filename-extension FIL))
1
)
)
(foreach ENT SS
(vlax-invoke
FILSYS
"deletefile"
(strcat FILDIR "\\" ENT)
:vlax-false
)
)
(vlax-release-object FILSYS)
)
;;3 本程序主程序:1转成dxf 2原文件改名为备份 3打开另存为2K 4删除dxf
(setq BaseName (vl-filename-base DwgName)
filepath (vl-filename-directory DwgName)
dxfFile (vl-string-subst ".dxf" ".dwg" DwgName)
BackupFile (strcat (getfullpath filepath)
BaseName
"_Backup"
(vl-filename-extension DwgName)
)
)
(Dwg2Dxf DwgName dxfFile) ;利用objectdbx转存文件,目的是去教育版印戳
(if (findfile BackupFile)
(deletefile BackupFile)
) ;检查原dwg文件的备份文件名是否存在,如果存在,则删除
(if (vl-file-rename DwgName BackupFile) ;修改原dwg文件名
(progn
(setq
DocObj (vla-open (vla-get-documents (vlax-get-acad-object))
dxfFile
)
) ;打开dxf文件
(vla-saveas DocObj DwgName acR15_DWG) ;再存为2k版dwg文件
(vla-close DocObj :vlax-false)
(deletefile dxfFile) ;删除dxf文件
)
)
(princ)
)
;;154.4 [功能] 将文件以Wblock输出,并去教育版(文件名不变)
;;非打开的文件
;;示例 (DwgOutWblock "D:\\Drawing1.dwg")
(defun DwgOutWblock
(DwgName / BACKUPFILE BASENAME
DOCOBJ DXFFILE FILEPATH NEWSET
SSETS
)
;;1 获取全路径,即路径后有
(defun GetFullPath (path)
(if (wcmatch path "*\\")
path
(strcat path "\\")
)
)
;;2 能删除所有文件,不管只读、隐藏与否,都能删除
(defun DeleteFile (FIL / FILSYS FILDIR SS ENT)
(setq FILSYS (vlax-create-object "Scripting.FileSystemObject"))
(setq FILDIR (vl-filename-directory FIL))
(setq
SS (vl-directory-files
FILDIR
(strcat (vl-filename-base FIL) (vl-filename-extension FIL))
1
)
)
(foreach ENT SS
(vlax-invoke
FILSYS
"deletefile"
(strcat FILDIR "\\" ENT)
:vlax-false
)
)
(vlax-release-object FILSYS)
)
;;3 本程序主程序:1转成dxf 2原文件改名为备份 3打开并以wblock输出 4删除dxf
(setq BaseName (vl-filename-base DwgName)
filepath (vl-filename-directory DwgName)
dxfFile (vl-string-subst ".dxf" ".dwg" DwgName)
BackupFile (strcat (getfullpath filepath)
BaseName
"_Backup"
(vl-filename-extension DwgName)
)
)
(Dwg2Dxf DwgName dxfFile) ;利用objectdbx转存文件,目的是去教育版印戳
(if (findfile BackupFile)
(deletefile BackupFile)
) ;检查原dwg文件的备份文件名是否存在,如果存在,则删除
(if (vl-file-rename DwgName BackupFile) ;修改原dwg文件名
(progn
(setq
DocObj (vla-open (vla-get-documents (vlax-get-acad-object))
dxfFile
)
) ;打开dxf文件
(setq ssets (vla-get-selectionsets DocObj))
(if (vl-catch-all-error-p
(vl-catch-all-apply 'vla-item (list ssets "$Set"))
)
(setq newSet (vla-add ssets "$Set"))
(progn
(vla-delete (vla-item ssets "$Set"))
(setq newSet (vla-add ssets "$Set"))
)
)
;;select all objects in the drawing
(vla-Select newSet acSelectionSetAll)
(vla-WBlock DocObj DwgName newSet)
(vla-close DocObj :vlax-false)
(deletefile dxfFile) ;删除dxf文件
)
)
(princ)
)
**** Hidden Message *****
cable2004
发表于 2012-10-23 15:16:22
不错!完全学习。。。。。
Q1241274614
发表于 2012-10-23 15:37:52
好程序!。。。。。。。。。。。。。
pxt2001
发表于 2012-10-23 22:45:10
收集也是辛苦的劳动。
crtrccrt
发表于 2012-10-24 08:02:07
一个字
很好
牛仔key
发表于 2012-10-24 10:32:10
没钱下载了,但是支持楼主了
mycad
发表于 2012-10-24 13:15:06
支持!!!!!!!!!!!!!!!!!!!!