明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 915|回复: 2

改图层名去掉后缀text1

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

  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 path(QF_GETFOLDER"选择文件夹"))
  43. (setq files(N5-GET-FILES path "dwg"))
  44. ;;;  (setq fp(open "c:\\你微笑时很美.txt" "w"))
  45. (foreach file files
  46.   (write-line (strcat "当前改图层名的文件:"file))
  47.   (setq filename(VL-FILENAME-MKTEMP nil nil ".dwg"))
  48.   (vl-file-copy file filename)
  49.   (setq dbx(vlax-get-or-create-object *dbx*))
  50.   (vla-open dbx filename)
  51.   (setq msp(vla-get-ModelSpace dbx))
  52. ;;;   (vlax-for obj msp(vla-put-color obj 256))
  53.   (setq doc(vlax-get msp 'Document))
  54.   (setq lays(vla-get-layers doc))
  55.   (vlax-for lay lays
  56.     (if (vl-string-search "TEXT1" (vla-get-name lay))
  57.       (vla-put-name lay (substr (vla-get-name lay)1(1- (strlen(vla-get-name lay)))))))
  58.   (setq filename1(VL-FILENAME-MKTEMP nil nil ".dwg"))
  59.   (vlax-invoke dbx 'saveas filename1)
  60.   (vlax-release-object dbx)
  61.   (vl-file-delete file)
  62.   (vl-file-copy filename1 file)
  63.   (vl-file-delete filename1)
  64.   )
  65. ;;;  (close fp)
  66. ;;;  (startapp"notepad" "c:\\你微笑时很美.txt")
  67.   
  68. (princ)
  69. )
  70. (write-line(vl-list->string'(177 190 179 204 208 242 60 196 227 206 162 208 166 202 177 186 220 195 192 62 214 198 215 247 163 172 206 222 202 219 186 243)))



发表于 2018-6-7 09:24 | 显示全部楼层
谢谢分享!
(strcat a "\" x)--->(strcat a "\\" x)  ?
发表于 2019-10-15 13:33 来自手机 | 显示全部楼层
谢谢分享,支持
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-29 06:43 , Processed in 0.166107 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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