[讨论]：如何将原图层名字母小写改为大写

啵浪鼓

因为当层在建层时,一些同事不太着重图层名大小写的命名,在lisp来讲,大小写一样的读写,但在PressCAD里用VB编出来的程序,图层名要求一律大写才认(可能原程序设计者本人未考虑此问题亦或者其它未可知的原因),就拿关闭图层来讲,如果是字母小写的就没法关闭或者打开,需手动去开关...

我曾试着这样写一段程序,比如名为text的图层改为TEXT,先建立一个暂存图名TMP,将TEXT图层内所有物体先复制到TMP图层,删除text图层再建TEXT图层,但如此这样,常常遇到原text图层没法删除,提示图层内仍有物体,单开此图层又不显示,可能某些text物体跟着一些群组(group)或是块(block)在一起,如果要全删了的话就得将这些群组(group)或块(block)也全部删掉,这样肯定是不行的...

另一种办法是新开一个档案,事先将图层按字母大写写好,再将原图档拷贝过来,但这样又造成原来一些属性什么的都没了,还有一些标注,公差,字型什么的都乱了,这样更不行了...

请问有没有更好的办法或者程序来完成?~!

舟自横

简单的:TEBLSEARCH图档中所有的图层,然后用循环STRCASE改变大小写不就可以了!

啵浪鼓

靠,具体要怎样写,编个程序出来

舟自横

(defun c:layer_out(/ file ff cord_layer layername layercolor layerlinetype)
  (setvar "cmdecho" 0)
  (vl-mkdir "D:\\mylisp")
  (setq file (strcat "D:\\mylisp\\" "lds.dat"))
  (setq ff (open file "w"))
  (setq cord_layer (tblnext "layer"))
  (while cord_layer
    (setq layername (cdr(assoc 2 cord_layer)))
    (setq layercolor (cdr(assoc 62 cord_layer)))
    (setq layerlinetype (cdr(assoc 6 cord_layer)))
    (if (= layerlinetype "PHANTOM-2") (setq layerlinetype "PHANTOM2"))
    (princ (strcat layername "," (itoa layercolor) "," layerlinetype ",") ff)
    (princ "\n" ff)
    (setq cord_layer (tblnext "layer"))
    )
  (close ff)
(prompt "\n-------OK!!LAYER PUT OUT-------")
(PRIN1)
);;;;将档案中的所有图曾资料输出到外部文件
(defun c:layer_renew(/ ff fp u data i layer_list datastring tempchar)
  (setvar "cmdecho" 0)
  (if (= (setq fp (findfile "lds.dat")) nil) (progn (alert "\n圖層數據庫丟失!")(exit))
     (setq ff (open fp "r"))
      )
  (setq u 0)
  (setq data (read-line ff))
  (command "undo" "be")
  (while data
         (setq i 1)
         (setq layer_list '())
         (setq datastring data)
         (while (/= (setq TempChar (substr Datastring i 1)) "")
                (if (= TempChar ",") (progn
                   (setq layer_list (cons(substr Datastring 1 (- i 1)) layer_list))
                   (setq Datastring (substr Datastring (+ 1 i)))
                   (setq i 0)
                         )
                  )
                   (setq i (1+ i))
           )
    (setq layer_list (reverse layer_list))
         (if (= (tblsearch "layer" (nth 0 layer_list)) nil)
         (command "layer" "n" (STRCASE(nth 0 layer_list) )"c" (atoi (nth 1 layer_list)) (nth 0 layer_list)"l"
          (nth 2 layer_list) (nth 0 layer_list)""))
         (setq data (read-line ff))
    (setq u (1+ u))
    )
  (command "undo" "e")
  (close ff)
  (prin1)
);;;;找到外部文件在图档中新建图层
这是我以前写的两个程序,相信对你有用
虽然没有完全按照你的意思但是相信你能
从中得到启发!!

f5612140

(defun c:test()
(setq acadobj (vlax-get-acad-object))
(setq dwgobj (vla-get-ActiveDocument acadobj))
(setq mspace (vla-get-ModelSpace dwgobj))
(setq layersobj (vla-get-layers dwgobj))
(setq count (vla-get-count layersobj))
(setq i 0)
(repeat count
   (setq layobj (vla-item layersobj i))
   (setq lay (vla-get-Name layobj))
   (setq lay (strcase lay))
   (vla-put-Name layobj lay)
   (setq i (+ i 1))
)
(prin1)
)

啵浪鼓

五楼的f5612140 朋友真厉害,几句话就搞定了,汗颜啊~

这(prin1)表示什么?不是常用princ的吗?

jinsong-liao

往命令行打印一个表达式或写一个表达式到一个已打开的文件中。
prin1函数也可以不带变元被调用，这时也将返回（和打印）空字符串。如果您在用户定义的函数中使用prin1（不带变元）作为最后的表达式，当函数执行完成时仅会打印一个空行，这就为应用程序"静静地"退出提供了手段。

啵浪鼓

CAD2006运行5楼的程序没问题,我在公司里用CAD2002版时提示
vlax-get-acad-object 错误
如何加载???

伊伊哎哎

最初由 f5612140 发布
[B](defun c:test()
(setq acadobj (vlax-get-acad-object))
(setq dwgobj (vla-get-ActiveDocument acadobj))
(setq mspace (vla-get-ModelSpace dwgobj))
(setq layersobj (vla-get-layers dwgobj))
(setq ... [/B]

CAD2006不用调用即可加载,可在CAD2002出现错误函数,请教如何设置提用,错误命令如下:
vlax-get-acad-object错误

狂刀

回答加载问题兼简化程序.
[php]
(defun c:lan ( / nm)
  (vl-load-com) ;;加载支持vlax-
  (vlax-map-collection
    (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object)))
    '(lambda(x)(setq nm (vla-get-Name x))
       (vla-put-name x (strcase nm)))
  )(princ)
)[/php]

啵浪鼓

收到,谢谢~

midali2005

谢谢提供