panliang9 发表于 2022-12-26 17:00:51

(国外搬运）用CSV文件重命名图块和图层

本帖最后由 panliang9 于 2022-12-26 17:18 编辑

这是一个用CSV文件来重命名所有图块或者图层的程序，我一段段的粘到CAD里可以有用，但一整个调用就不对了。谁有空帮我调一下。

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-to-rename-layers-blocks-based-on-a-csv-txt-file/m-p/9713623#M403905



原贴附件



;; gc:str2lst;; Transforme un chaine avec séparateur en liste de chaines;;;; Arguments;; str : la chaîne;; sep : le séparateur(defun gc:str2lst (str sep / pos)(if (setq pos (vl-string-search sep str))    (cons (substr str 1 pos) (gc:str2lst (substr str (+ (strlen sep) pos 1)) sep))    (list str)))(defun oe:RenBlock (old new) (if   (and   (tblsearch "BLOCK" old)   (not (tblsearch "BLOCK" new))   (snvalid new)   )    (progn       (if         (vl-catch-all-error-p         (vl-catch-all-apply             'vla-put-name             (list               (vla-item (vla-get-blocks                           (cond (*AcadDoc*)                                 ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))                           )                         )                         old               )               new             )         )         )          (princ (strcat "\nBlock: " old " could not be renamed to: " new))          (princ (strcat "\nBlock: " old " renamed to: " new))      )    )))(defun oe:RenLayer (old new) (if   (and   (tblsearch "LAYER" old)   (not (tblsearch "LAYER" new))   (snvalid new)   )    (progn       (if         (vl-catch-all-error-p         (vl-catch-all-apply             'vla-put-name             (list               (vla-item (vla-get-layers                           (cond (*AcadDoc*)                                 ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))                           )                         )                         old               )               new             )         )         )          (princ (strcat "\nLayer: " old " could not be renamed to: " new))          (princ (strcat "\nLayer: " old " renamed to: " new))      )    )))(defun C:RenBlock ( / sFile oFile sInfos)(if (and      (setq sFile (getfiled "Select a block CSV File" (getvar "DWGPREFIX") "CSV" 8))      (setq sFile (findfile sFile))      )    (progn      (setq sSep (vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList"))      (setq oFile (open sFile "r"))      (while (setq sLine (read-line oFile))      (setq sInfos (gc:str2lst sLine sSep))      (if (= (length sInfos) 2)          (oe:RenBlock (car sInfos) (cadr sInfos))      )      )      (close oFile)    ))(princ))(defun C:RenLayer ( / sFile oFile sInfos)(if (and      (setq sFile (getfiled "Select a layer CSV File" (getvar "DWGPREFIX") "CSV" 8))      (setq sFile (findfile sFile))      )    (progn      (setq sSep (vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList"))      (setq oFile (open sFile "r"))      (while (setq sLine (read-line oFile))      (setq sInfos (gc:str2lst sLine sSep))      (if (= (length sInfos) 2)          (oe:RenLayer (car sInfos) (cadr sInfos))      )      )      (close oFile)    ))(princ))

lxl217114 发表于 2022-12-26 18:53:41

本帖最后由 lxl217114 于 2022-12-26 18:58 编辑

谢谢大佬分享实用工具

中国梦 发表于 2022-12-26 20:02:52

谢谢楼主分享

hzyhzjjzh 发表于 2022-12-27 13:07:10

谢谢楼主分享{:1_1:}

xyp1964 发表于 2022-12-27 13:21:01


;; (gc:str2lst "CAP;block capacit" ";") → ("CAP" "block capacit")
(defun gc:str2lst (str sep / pos)
(if (setq pos (vl-string-search sep str))
    (cons (substr str 1 pos)
          (gc:str2lst (substr str (+ (strlen sep) pos 1)) sep)
    )
    (list str)
)
)

(defun oe:RenBlock (old new)
(if (and (tblsearch "BLOCK" old)
           (not (tblsearch "BLOCK" new))
           (snvalid new)
      )
    (if        (vl-catch-all-error-p
          (vl-catch-all-apply
          'vla-put-name
          (list
              (vla-item        (vla-get-blocks
                          (cond        (*AcadDoc*)
                                ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object)))
                                )
                          )
                        )
                        old
              )
              new
          )
          )
        )
      (princ
        (strcat "\nBlock: " old " could not be renamed to: " new)
      )
      (princ (strcat "\nBlock: " old " renamed to: " new))
    )
)
)
(defun oe:RenLayer (old new)
(if (and (tblsearch "LAYER" old)
           (not (tblsearch "LAYER" new))
           (snvalid new)
      )
    (if        (vl-catch-all-error-p
          (vl-catch-all-apply
          'vla-put-name
          (list
              (vla-item        (vla-get-layers
                          (cond        (*AcadDoc*)
                                ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object)))
                                )
                          )
                        )
                        old
              )
              new
          )
          )
        )
      (princ
        (strcat "\nLayer: " old " could not be renamed to: " new)
      )
      (princ (strcat "\nLayer: " old " renamed to: " new))
    )
)
)
(defun C:RenBlock (/ sFile oFile sInfos)
(if (and (setq sFile (getfiled "Select a block CSV File"
                               (getvar "DWGPREFIX")
                               "CSV"
                               8
                     )
           )
           (setq sFile (findfile sFile))
      )
    (progn
      (setq oFile (open sFile "r"))
      (while (setq sLine (read-line oFile))
        (setq sInfos (gc:str2lst sLine ";"))
        (if (= (length sInfos) 2)
          (oe:RenBlock (car sInfos) (cadr sInfos))
        )
      )
      (close oFile)
    )
)
(princ)
)

(defun C:RenLayer (/ sFile oFile sInfos)
(if (and (setq sFile (getfiled "Select a layer CSV File"
                               (getvar "DWGPREFIX")
                               "CSV"
                               8
                     )
           )
           (setq sFile (findfile sFile))
      )
    (progn
      (setq oFile (open sFile "r"))
      (while (setq sLine (read-line oFile))
        (setq sInfos (gc:str2lst sLine ";"))
        (if (= (length sInfos) 2)
          (oe:RenLayer (car sInfos) (cadr sInfos))
        )
      )
      (close oFile)
    )
)
(princ)
)

panliang9 发表于 2022-12-27 17:11:34

谢谢“xyp1964”！！！！

BHL-DONG 发表于 2022-12-27 19:41:12

论坛里面真的是藏龙卧虎啊

ninja37 发表于 2022-12-28 10:03:45

谢大佬分享实用工具{:1_1:}

ferious 发表于 2023-4-21 10:34:18

xyp1964 发表于 2022-12-27 13:21


加载了无gc命令？:lol

bing00 发表于 2023-8-18 18:26:12

试了下不能用吧
页: [1]
查看完整版本: (国外搬运）用CSV文件重命名图块和图层