明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 828|回复: 0

王伟冻结图层

[复制链接]
发表于 2018-6-6 17:36:38 | 显示全部楼层 |阅读模式

  1. (defun qf_getFolder (msg / WinShell shFolder path catchit)
  2.   (vl-load-com)
  3.   (setq winshell (vlax-create-object "Shell.Application"))
  4.   (setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))
  5.   (setq
  6.     catchit (vl-catch-all-apply
  7.           '(lambda ()
  8.          (setq shFolder (vlax-get-property shFolder 'self))
  9.          (setq path (vlax-get-property shFolder 'path))
  10.            )
  11.         )
  12.   )
  13.   (if (vl-catch-all-error-p catchit)
  14.     nil
  15.     path
  16.   )
  17. )

  18. ;|函数功能: 获取目录下(包含子目录)里的某类型文件
  19. ;使用格式: a为路径名或多个路劲名表,b为扩展名
  20. ;范    例: (n5-get-files "D:" "lsp"),搜索d盘中所有lsp文件|;
  21. ;(setq c(n5-get-files b "dat"))
  22. ;(vl-file-directory-p b)返回T
  23. ;2016-6-11
  24. ;095
  25. (defun n5-get-files(a b / lst mulu wj x )
  26.   (setq lst '())
  27. (cond
  28. ((= (type a)'STR)
  29.   (if (setq wj (mapcar '(lambda(x)(strcat a "\" x))(vl-directory-files a (strcat"*." b))))
  30.       (setq lst (cons wj lst)))
  31.   (if (setq mulu (mapcar '(lambda(x)(strcat a "\" x))(cddr(vl-directory-files a nil -1))))
  32.     (foreach x mulu(setq lst(cons(n5-get-files x b) lst)))
  33.       )
  34. )
  35. ((= (type a) 'list) (foreach x a (setq lst (cons(n5-get-files x b)lst))))
  36. )
  37.     (reverse(apply 'append lst))
  38. )

  39. (defun lst-(l1 l2)(if l2(foreach x l2(setq l1(vl-remove x l1)))l1))


  40. (defun c:tt( / *DBX* DBX DOC FILENAME FILENAME1 FILES LAYS MSP PATH)
  41. (setq *dbx* (strcat "ObjectDBX.AxDbDocument."(substr (getvar "acadver") 1 2)))
  42. (setq lst'("Pipe_APP_P" "Device_Point"))
  43. (setq path(QF_GETFOLDER"选择文件夹"))
  44. (setq files(N5-GET-FILES path "dwg"))
  45. ;;;  (setq fp(open "c:\\你微笑时很美.txt" "w"))
  46. (foreach file files
  47.   (write-line (strcat "当前冻结图层文件:"file))
  48.   (setq filename(VL-FILENAME-MKTEMP nil nil ".dwg"))
  49.   (vl-file-copy file filename)
  50.   (setq dbx(vlax-get-or-create-object *dbx*))
  51.   (vla-open dbx filename)
  52.   (setq msp(vla-get-ModelSpace dbx))
  53. ;;;   (vlax-for obj msp(vla-put-color obj 256))
  54.   (setq doc(vlax-get msp 'Document))
  55.   (setq lays(vla-get-layers doc))
  56.   (vlax-for lay lays(if (member (vla-get-name lay)lst) (vla-put-Freeze lay :vlax-true)))
  57.   (setq filename1(VL-FILENAME-MKTEMP nil nil ".dwg"))
  58.   (vlax-invoke dbx 'saveas filename1)
  59.   (vlax-release-object dbx)
  60.   (vl-file-delete file)
  61.   (vl-file-copy filename1 file)
  62.   (vl-file-delete filename1)
  63.   )
  64. ;;;  (close fp)
  65. ;;;  (startapp"notepad" "c:\\你微笑时很美.txt")
  66. (princ)
  67. )


您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-5 21:48 , Processed in 0.167438 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表