牛仔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

支持!!!!!!!!!!!!!!!!!!!!
页: 1 2 3 4 5 6 7 8 [9] 10 11 12 13 14 15 16 17 18
查看完整版本: 常用函数.lsp