对于未打开的文件列表，事先判断哪些是Auocad能打开的

自贡黄明儒

;;对于未打开的文件列表，事先判断哪些是Auocad能打开的
;;示例(OpenFileList '("D:\\drawing1" "D:\\drawing2"))
(defun OpenFileList (dwgfileLst / N NOTOPENFILELST TMPFILE)
  ;;获取ObjectDBX版本字符串
  (defun GetObjectDBXVer (/ VERSION)
    (if        (>= (setq VERSION (atoi (getvar "acadver"))) 16)
      (strcat "ObjectDBX.AxDbDocument." (itoa VERSION))
    )
  )
  ;; 对于非打开文件进行检查,看是否能打开
  (defun CanSuccessOpen        (DwgName / ACADAPP CATCHIT DBXDOC)
    (setq AcadApp (vlax-get-acad-object)
          dbxDoc  (vla-GetInterfaceObject
                    AcadApp
                    (GetObjectDBXVer)
                  )
    )
    (setq catchit (vl-catch-all-apply 'vla-open (list dbxDoc DwgName)))
    (if        dbxDoc
      (vlax-release-object dbxDoc)
    )                                        ;关闭文档
    (if        AcadApp
      (vlax-release-object AcadApp)
    )
    (vl-catch-all-error-p catchit)
  )
  ;; 添加分隔符函数
  (defun AddSeprate (DataList delimiter / i len dealdata TempData)
    (setq i   1
          len (length DataList)
    )
    (if        len
      (progn
        (setq dealdata (nth 0 DataList))
        (if (numberp dealdata)
          (setq dealdata (rtos dealdata 2))
        )
        (repeat        (1- len)
          (setq TempData (nth i DataList))
          (if (numberp TempData)
            (setq TempData (rtos TempData 2))
          )
          (setq dealdata (strcat dealdata delimiter TempData))
          (setq i (1+ i))
        )
      )
    )
    (setq DataList dealdata)
  )

  (if dwgfileLst
    (repeat (setq n (length dwgfileLst))
      (setq tmpfile (nth (setq n (1- n)) dwgfileLst))
      (if (CanSuccessOpen tmpfile)
        (setq NotOpenFileLst (cons tmpfile NotOpenFileLst))
      )
    )
  )
  (if NotOpenFileLst
    (progn
      (repeat (setq n (length NotOpenFileLst))
        (setq tmpfile (nth (setq n (1- n)) NotOpenFileLst))
        (setq dwgfileLst (vl-remove tmpfile dwgfileLst))
      )
      (alert
        (strcat
          "以下文件可能已经损坏，或者需要高版本才能打开：\n"
          (AddSeprate NotOpenFileLst "\n")
        )
      )
    )
  )
  dwgfileLst
)

gzxl

坐沙发顶几下