;;; 块转外部引用[WG_BlockToXref].LSP
;;; Convert Blocks to Xrefs
;;; Select one or many blocks in a drawing and change them to xrefs
;;; The xrefs needs to be existing before running this command

;;; By Jimmy Bergmark
;;; Copyright (C) 1997-2014 JTB World, All Rights Reserved
;;; Website: www.jtbworld.com
;;; E-mail: info@jtbworld.com

;;; 2000-04-03 - First release
;;;		 Supports nested blocks, multiple tabs
;;; 2014-12-15 - Updated to work with newer versions of AutoCAD
;;; Tested on AutoCAD 2000 and 2015

(defun c:WG_BlockToXref ( /            errexit      undox
							olderr       restore      errexitA2k oldcmdecho oldcvport
							ss ss1 ss2 e1 ix path
							bsl bn bnl bl bt not_ok repl oldvport oldregenmode
							typ ed layer color ltype ang ins tab oldtab
						)
						; (progn
(defun errexit (s)
	(princ "\nError:  ")
	(princ s)
	(restore)
)

(defun undox ()
	(setvar "ctab" oldtab)
	(command (if (> oldcvport 1) "._mspace" "._pspace"))
	(setvar "cvport" oldcvport)
	(setvar "regenmode" oldregenmode)
	(if (>= (atof (getvar "AcadVer")) 20)
		(command-s "_.undo" "_E")
		(command "_.undo" "_E")
	)
	(setvar "cmdecho" oldcmdecho)
	(setq *error* olderr)
	(princ)
)

	(setq
		olderr  *error*
		restore undox
		*error* errexit
		oldcmdecho (getvar "cmdecho")
		oldtab (getvar "ctab")
		oldcvport (getvar "cvport")
		oldregenmode (getvar "regenmode")
	)
	(setvar "cmdecho" 0)
	(setvar "regenmode" 0)
	(if (>= (atof (getvar "AcadVer")) 20)
		(command-s "_.undo" "_bE")
		(command "_.undo" "_bE")
	)
	(or (>= (substr (getvar "ACADVER") 1 2) "15") (exit))
	(or (setq ss1 (ssget '((0 . "INSERT")))) (exit))
	; bsl block selection list
	; bnl unique block name list
	(foreach e1 (mai_ssget_2_list ss1)
		(setq
			bn (mai_dxf 2 e1) ; block name
			bl (tblsearch "block" bn) ; block list bn
			bt (mai_dxf 70 bl) ; block type
		)
		(and
			(/= (logand bt 4) 4)
			(not (member bn bnl)) ; no xrefs and no duplicates
			(setq bnl (cons bn bnl))
		)
	); end repeat

	(foreach bn bnl
		(setq ss1 (ssget "X" (list (cons 0 "INSERT") (cons 2 bn))))
		(foreach e1 (mai_ssget_2_list ss1)
			(setq bsl (cons (entget e1) bsl))
		)
	); end repeat

	(foreach bn bnl
		(setq not_ok T)
		(while not_ok
			(setq path
				(mai_GetFile
					"必需选择外部引用文件代替块"
					(if path
						(strcat (vl-filename-directory path) "\\" bn)
						(strcat (getvar "dwgprefix") bn)
					)
					"dwg"
				)
			)
			(if path
				(if (= (strcase (vl-filename-base path)) (strcase bn))
					(setq not_ok nil)
					(progn
						(initget 0 "Yes No")
						(setq repl (getkword "\n改成其它文件名? [Yes/No] <No>:"))
						(or repl (setq repl "Yes"))
						(setq not_ok (not (= "Yes" repl)))
					)
				)
			)
			(if not_ok
				(or path (setq not_ok nil))
				(progn
					(setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 bn))))
					(foreach ed (mai_ssget_2_list ss)
						(setq tab (mai_dxf 410 (entget ed)))
						(setvar "ctab" tab)
						(entdel ed)
					)
					(mai_purge_all)
					(initget 0 "Overlay Attach")
					(setq repl (getkword "\n输入选项 [Overlay/Attach] <Attach>:"))
					(or repl (setq repl "Attach"))
					(setq typ (if (= "Attach" repl) "_A" "_O"))
					(foreach ed bsl
						(if (= bn (mai_dxf 2 ed))
							(progn
								(setq
									layer (mai_dxf 8 ed)
									color (cond ((mai_dxf 62 ed)) ("_ByLayer"))
									ltype (cond ((mai_dxf 6 ed)) ("_ByLayer"))
									ang (/ (* 180.0 (mai_dxf 50 ed)) pi)
									ins (mai_dxf 10 ed)
									tab (mai_dxf 410 ed)
								)
								(setvar "ctab" tab)
								(or (= (strcase tab) "MODEL") (command "._pspace"))
								(vl-cmdf "._xref" typ path "_X" (mai_dxf 41 ed) "_Y" (mai_dxf 42 ed) "_Z" (mai_dxf 43 ed) ins ang)
								(vl-cmdf "._change" "_L" "" "_P" "_C" color "_LA" layer "_LT" ltype "")
							)
						)
					)
				)
			)
		)
	)
	(restore)
)




