;;; 块转外部引用[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
                      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)
)




