块交换器lisp-请求
我非常喜欢lisps，但对其语言和结构一无所知。任何人都可以用柚木帮助这个Lisp程序请-
目前，它允许您交换特定的块实例，方法是选择它们，然后键入要替换它们的块的名称。
我需要能够在屏幕上选择替换块。
(defun c:blkreplacer (/ answr ent idx newname obj ss)
(vl-load-com)
;;setup default on first run
(if (not jmm-replaceall)
(setq jmm-replaceall "Single")
)
(command ".undo" "be")
;;if the user selects something, inputs a ne block name AND it exists in the dwg...
(if (and (setq ss (ssget '((0 . "INSERT"))));;REMOVED THE :S
(progn
(initget "Single Global")
(if (setq answr (getkword "\nReplace just this Single selection or Globally replace?: "))
(setq jmm-replaceall answr)
(setq answr jmm-replaceall)
)
)
(setq newname (getstring "\nBlock name to replace with: "))
(tblobjname "BLOCK" newname)
)
(progn
(if (eq jmm-replaceall "Global");;get ALL occurances if it's Global, else use the original ss
(setq ss (ssget "x" (list '(0 . "INSERT") (assoc 2 (entget (ssname ss 0))))))
)
(setq idx -1)
(while (setq ent (ssname ss (setq idx (1+ idx))))
(setq obj (vlax-ename->vla-object ent))
(vla-put-name obj newname);;change the name
(vla-update obj)
)
)
)
(command ".undo" "end")
(princ (strcat "\nReplaced " (itoa idx) " blocks......"))
(princ)
) 尝试添加洋红色的代码；未测试：
...
;(setq newname (getstring "\nBlock name to replace with: "))
(not (prompt "\nBlock name to replace with: "))
(if (setq ssTemp (ssget ":S" '((0 . "INSERT"))))
(cdr (assoc 2 (entget (ssname ssTemp 0))))
)
(tblobjname "BLOCK" newname)
... (defun c:blkreplacer (/ blcks a answr ent idx newname obj ss)
(vl-load-com)
(setq blcks nil)
(while (setq a (tblnext "BLOCK" (null a)))
(setq blcks (cons (cdr (assoc 2 a)) blcks)))
;;setup default on first run
(if (not jmm-replaceall)
(setq jmm-replaceall "Single")
)
(command ".undo" "be")
;;if the user selects something, inputs a ne block name AND it exists in the dwg...
(if (and (setq ss (ssget '((0 . "INSERT"))));;REMOVED THE :S
(progn
(initget "Single Global")
(if (setq answr (getkword "\nReplace just this Single selection or Globally replace?: "))
(setq jmm-replaceall answr)
(setq answr jmm-replaceall)
)
)
;;; (setq newname (getstring "\nBlock name to replace with: "))
;;; (tblobjname "BLOCK" newname)
(setq newname (car (LM:ListBox "Select an Item" blcks n)))
)
(progn
(if (eq jmm-replaceall "Global");;get ALL occurances if it's Global, else use the original ss
(setq ss (ssget "x" (list '(0 . "INSERT") (assoc 2 (entget (ssname ss 0))))))
)
(setq idx -1)
(while (setq ent (ssname ss (setq idx (1+ idx))))
(setq obj (vlax-ename->vla-object ent))
(vla-put-name obj newname);;change the name
(vla-update obj)
)
)
)
(command ".undo" "end")
(princ (strcat "\nReplaced " (itoa idx) " blocks......"))
(princ)
)
;;-----------------------=={ List Box }==---------------------;;
;; ;;
;;Displays a List Box allowing the user to make a selection ;;
;;from the supplied data. ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright © 2012 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;title - List Box Dialog title ;;
;;lst - List of Strings to display in the List Box ;;
;;multiple - Boolean flag to determine whether the user ;;
;; may select multiple items (T=Allow Multiple) ;;
;;------------------------------------------------------------;;
;;Returns:List of selected items, else nil. ;;
;;------------------------------------------------------------;;
(defun LM:ListBox ( title lst multiple / dch des tmp res )
(cond
( (not
(and
(setq tmp (vl-filename-mktemp nil nil ".dcl"))
(setq des (open tmp "w"))
(write-line
(strcat
"listbox : dialog { label = \""
title
"\"; spacer; : list_box { key = \"list\"; multiple_select = "
(if multiple "true" "false")
"; } spacer; ok_cancel; }"
)
des
)
(not (close des))
(< 0 (setq dch (load_dialog tmp)))
(new_dialog "listbox" dch)
)
)
(prompt "\nError Loading List Box Dialog.")
)
( t
(start_list "list")
(foreach item lst (add_list item))
(end_list)
(setq res (set_tile "list" "0"))
(action_tile "list" "(setq res $value)")
(setq res
(if (= 1 (start_dialog))
(mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" res ")")))
)
)
)
)
(if (< 0 dch)
(unload_dialog dch)
)
(if (and tmp (setq tmp (findfile tmp)))
(vl-file-delete tmp)
)
res
)
谢谢MSasu
(defun c:blkchang (/ answr ent idx newname obj ss)
(vl-load-com)
;;setup default on first run
(if (not jmm-replaceall)
(setq jmm-replaceall "Single")
)
(command ".undo" "be")
;;if the user selects something, inputs a ne block name AND it exists in the dwg...
(if (and (setq ss (ssget '((0 . "INSERT"))));;REMOVED THE :S
(progn
(initget "Single Global")
(if (setq answr (getkword "\nReplace just this Single selection or Globally replace?: "))
(setq jmm-replaceall answr)
(setq answr jmm-replaceall)
)
)
;(setq newname (getstring "\nBlock name to replace with: "))
(not (prompt "\nBlock name to replace with: "))
(if (setq ssTemp (ssget ":S" '((0 . "INSERT"))))
(cdr (assoc 2 (entget (ssname ssTemp 0))))
)
(tblobjname "BLOCK" newname)
)
(progn
(if (eq jmm-replaceall "Global");;get ALL occurances if it's Global, else use the original ss
(setq ss (ssget "x" (list '(0 . "INSERT") (assoc 2 (entget (ssname ss 0))))))
)
(setq idx -1)
(while (setq ent (ssname ss (setq idx (1+ idx))))
(setq obj (vlax-ename->vla-object ent))
(vla-put-name obj newname);;change the name
(vla-update obj)
)
)
)
(command ".undo" "end")
(princ (strcat "\nReplaced " (itoa idx) " blocks......"))
(princ)
)给出此错误消息
pBe-也谢谢你。
这更好-但是，这会为您提供一个列表，其中有一个块名可供选择，用于替换块。希望修复它，因此只需指向并单击所需的块，而无需知道块名。 对不起，我错过了一些东西：
...
;(setq newname (getstring "\nBlock name to replace with: "))
(not (prompt "\nBlock name to replace with: "))
(if (setq ssTemp (ssget ":S" '((0 . "INSERT"))))
(setq newname (cdr (assoc 2 (entget (ssname ssTemp 0)))))
)
(tblobjname "BLOCK" newname)
...
完美的非常感谢你们两位。
我只是为了其他读者的利益张贴完整的lisp，他们可能会被lisp挑战像我一样
(defun c:blkchang (/ answr ent idx newname obj ss)
(vl-load-com)
;;setup default on first run
(if (not jmm-replaceall)
(setq jmm-replaceall "Single")
)
(command ".undo" "be")
;;if the user selects something, inputs a ne block name AND it exists in the dwg...
(if (and (setq ss (ssget '((0 . "INSERT"))));;REMOVED THE :S
(progn
(initget "Single Global")
(if (setq answr (getkword "\nReplace just this Single selection or Globally replace?: "))
(setq jmm-replaceall answr)
(setq answr jmm-replaceall)
)
)
;(setq newname (getstring "\nBlock name to replace with: "))
(not (prompt "\nBlock name to replace with: "))
(if (setq ssTemp (ssget ":S" '((0 . "INSERT"))))
(setq newname (cdr (assoc 2 (entget (ssname ssTemp 0)))))
(cdr (assoc 2 (entget (ssname ssTemp 0))))
)
(tblobjname "BLOCK" newname)
)
(progn
(if (eq jmm-replaceall "Global");;get ALL occurances if it's Global, else use the original ss
(setq ss (ssget "x" (list '(0 . "INSERT") (assoc 2 (entget (ssname ss 0))))))
)
(setq idx -1)
(while (setq ent (ssname ss (setq idx (1+ idx))))
(setq obj (vlax-ename->vla-object ent))
(vla-put-name obj newname);;change the name
(vla-update obj)
)
)
)
(command ".undo" "end")
(princ (strcat "\nReplaced " (itoa idx) " blocks......"))
(princ)
)
我知道这一点。我刚刚给了你一个选择，但我可以修改它来选择一个块或从列表中选择。你想要吗？ 不，我现在很好，但非常感谢
嗯，我想你是对的。anyhoo公司
在选择匿名名称的块时请考虑这一点
(while (not (progn (prompt "\nBlock name to replace with: ")
(setq ssTemp (ssget ":S:E" '((0 . "INSERT"))))))
(princ "\nInvalid Selection"))
(setq newname (vla-get-effectivename (vlax-ename->vla-object (ssname ssTemp 0))))
页:
[1]
2