-
Notifications
You must be signed in to change notification settings - Fork 0
/
ReplaceBlock.lsp
56 lines (56 loc) · 1.89 KB
/
ReplaceBlock.lsp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
;;; BlockSwap replaces selected blocks.
;;; by John Uhden (updated 03-09-17)
;;;
(defun c:ReplaceBlock ( / *error* vars ok name1 obj1 name2 obj2 opt ss)
(vl-load-com)
(defun *error* (err)
(mapcar '(lambda (x)(setvar (car x)(cdr x))) vars)
(vla-endundomark *doc*)
(cond
((not err))
((wcmatch (strcase err) "*CANCEL*,*QUIT*"))
(1 (princ (strcat "\nERROR: " err)))
)
(princ)
)
(or *acad* (setq *acad* (vlax-get-acad-object)))
(or *doc* (setq *doc* (vla-get-ActiveDocument *acad*)))
(vla-endundomark *doc*)
(vla-startundomark *doc*)
(setq vars (mapcar '(lambda (x)(cons x (getvar x))) '("cmdecho")))
(mapcar '(lambda (x)(setvar (car x) 0)) vars)
(command "_.expert" (getvar "expert")) ;; dummy command
(while (not ok)
(setq obj1 (vlax-ename->vla-object (car (entsel "\nPick old block: "))))
(princ (strcat " Old block name = \"" (setq name1 (vla-get-name obj1)) "\""))
(setq obj2 (vlax-ename->vla-object (car (entsel "\nPick new block: "))))
(princ (strcat " New block name = \"" (setq name2 (vla-get-name obj2)) "\""))
(if (= name1 name2)
(prompt "\nSame old and new blocks selected.")
(setq ok 1)
)
)
(initget "Replaceall Select")
(setq opt (getkword
"\nEnter an option [Select/Replaceall] <Replaceall> ... "
)
opt (if opt opt "Replaceall")
)
(cond
((= opt "Select")
(prompt "\nSelect blocks to be replaced... ")
(setq ss (ssget (list (cons 0 "INSERT") (cons 2 name1))))
)
((= opt "Replaceall")
(setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 name1))))
)
)
(repeat (setq i (sslength ss))
(vla-put-name (vlax-ename->vla-object (ssname ss (setq i (1- i)))) name2)
)
(vla-regen (vla-get-activedocument (vlax-get-acad-object))
acActiveViewport
)
(*error* nil)
)
(defun c:BS ()(c:ReplaceBlock))