(defun c:blocktoxref()(acet-error-init (list(list"cmdecho"0"highlight"0)1))(acet-blocktoxref-ui)(acet-error-restore))(defun c:-blocktoxref()(acet-error-init (list(list"cmdecho"0"highlight"0"cmddia"0"filedia"0)1))(acet-blocktoxref-ui)(acet-error-restore))(defun acet-blocktoxref-ui(/ bna fna n prg)(if(not acet:blocktoxref-block)(setq acet:blocktoxref-block""))(if(=""(getvar"refeditname"))(setq bna(acet-ui-table-name-get (list"选择用外部参照替代的图块"acet:blocktoxref-block"block"2		 nil		"acet1509.hlp""blocktoxref")))(acet-alert"参照编辑激活时无法执行命令。"))(if bna(setq acet:blocktoxref-block bna))(if(and bna (not acet:blocktoxref-xref))(setq acet:blocktoxref-xref(strcat bna".dwg")))(if(and bna(setq fna(ACET-FILE-WRITEDIALOG "选择外部参照文件"acet:blocktoxref-xref"dwg"0)))(progn(setq acet:blocktoxref-xref fna)(if(progn (initget"Yes No")(/="No"(getkword"\n当完成时合并没有参照项？ <是(Y)>: ")))(setq prg T))(setq n(acet-block-to-xref bna fna prg))
(princ(acet-str-format"\n%1个块插入替换为外部参照: %2"n fna))(if(> n 0)(princ"\n结果可能显示直到下次重生成。")))))(defun c:blockreplace()(acet-error-init(list(list"cmdecho"0"highlight"0)1))(acet-blockreplace-ui)(acet-error-restore))(defun c:-blockreplace()(acet-error-init (list(list"cmdecho"0"highlight"0"cmddia"0)1))(acet-blockreplace-ui)(acet-error-restore))(defun acet-blockreplace-ui(/ bna bna2 n lk prg lst flag bnames)(if(not acet:blockreplace-blocksearch)(setq acet:blockreplace-blocksearch""))(if(=""(getvar"refeditname"))(setq bna(acet-ui-table-name-get(list"请选取要替换的图块："acet:blockreplace-block"block"2		 nil		"acet1509.hlp""blockreplace")))(acet-alert"参照编辑激活时命令不能执行。"))(if bna(setq acet:blockreplace-blocksearch bna))(if(not acet:blockreplace-blockreplace)(setq acet:blockreplace-blockreplace""))(while(and(not flag)bna(setq bna2(acet-ui-table-name-get(list(acet-str-format"选择块替换为 %1"bna)acet:blockreplace-blockreplace"block"2			 nil		"acet1509.hlp"	
"blockreplace"	))))(cond((acet-str-equal bna bna2)(acet-alert"错误。块名不相等。"))((and(setq lst(acet-block-referenced-tables bna2 nil))(setq bnames(cdr(assoc 2 lst)))(member(xstrcase bna)(mapcar 'xstrcase bnames)))(acet-alert(acet-str-format"无效。循环引用。 %1 引用 %2."bna2 bna)))(T(setq flag T))))(if(and bna bna2)(progn(setq acet:blockreplace-blockreplace bna2)(if(progn (initget"Yes No")(/="No"(getkword"\n完成时清理非参照项？ <是(Y)>: ")))(setq prg T))(setq lk(acet-layer-unlock-all))(if prg(setq lst(acet-block-referenced-tables bna nil)))(setq n(acet-block-replace bna bna2))(if lk(command"_.-layer""_lock"lk""))(if prg(acet-block-referenced-tables-purge lst))(princ(acet-str-format"\n%1 blocks replaced."n))(if(> n 0)(princ"\n结果可能不显示直到下次重生成。")))))(defun acet-block-to-xref(bna fna prg / tmp na bna2 j n tmp2 msg lst lalst lamap origlays lk e1)(setq bna2(acet-filename-ext-remove(acet-filename-path-remove fna)))(cond ((acet-str-equal bna bna2)(setq tmp bna)(setq n 1)
(while(and(setq bna(strcat tmp"-OLD"(itoa n)))(tblobjname"block"bna))(setq n(+ n 1)))(command"_.rename""_block"tmp bna))((and(setq na(tblobjname"block"bna2))(setq e1(entget na))(/= 4(logand 4(cdr(assoc 70 e1)))))(setq tmp2 bna2)(setq n 1)(while(and(setq bna2(strcat tmp2"-"(itoa n)))(tblobjname"block"bna2))(setq n(+ n 1)))(setq msg(acet-str-format "\n已有在指定的外部参照中有相同名称的标准图块: %1."tmp2)msg(strcat msg(acet-str-format"\n正使用 %1 替代."bna2)))(acet-alert msg)(setq fna(strcat bna2"="fna))))(acet-ui-progress-init"Converting blocks to xrefs"12)(setq origlays(acet-table-name-list"layer"))(acet-ui-progress-safe 1)(setq na(entlast))(acet-safe-command T T(list"_.-xref""_a"fna"0,0""0.00000001""0.00000001""0"))(if(not(equal na(entlast)))(progn(setq lk(acet-layer-unlock-all))(entdel(entlast))(command"_.redraw")	(acet-ui-progress-safe 2)(if(or prg(= 1(getvar"visretain")))(progn(acet-ui-progress-safe 3)(setq lst(acet-block-referenced-tables bna nil))	(acet-ui-progress-safe 4)
(if(= 1(getvar"visretain"))(setq lamap(acet-blocktoxref-local-to-xref-layer-map bna2)))(acet-ui-progress-safe 5)))(acet-ui-progress-safe 6)(setq j(acet-block-replace bna bna2))(acet-ui-progress-safe 8)(if lk(command"_.-layer""_lock"lk""))(acet-ui-progress-safe 9)(if lst(progn(if(and(= 1(getvar"visretain"))lamap(setq lalst(cdr(assoc 8 lst)))		)(acet-blocktoxref-apply-xref-layer-props lalst origlays lamap))(acet-ui-progress-safe 10)(if prg(acet-block-referenced-tables-purge lst))(acet-ui-progress-safe 12))))(princ"\n外部参照操作失败。"))(if(and tmp 					(tblobjname"block"bna)		(not(tblobjname"block"tmp))	)(command"_.rename"bna tmp))(acet-ui-progress-done)j)(defun acet-blocktoxref-local-to-xref-layer-map(xrefname / lst xla locla lst2 loclst)(setq xrefname(xstrcase xrefname)lst(bns_tbl_match"layer"(list(cons 2(strcat xrefname"|*"))'(-4 . "&")(cons 70(+ 16 32))))lst(mapcar '(lambda(x)(xstrcase(cdr(assoc 2 x))))lst)loclst(bns_tbl_match"layer"
(list '(-4 . "<NOT")'(-4 . "&")(cons 70(+ 16 32))'(-4 . "NOT>")))loclst(mapcar '(lambda(x)(xstrcase(cdr(assoc 2 x))))loclst))(foreach xla lst(if(setq locla(acet-blocktoxref-local-layer-name xla loclst))(setq lst2(cons(list locla xla)lst2))))(reverse lst2))(defun acet-blocktoxref-local-layer-name(xla loclst / xrefname layername lst n a b flag)(setq xla(xstrcase xla)n(acet-str-find"|"xla)xrefname(substr xla 1(- n 1))layername(substr xla(+ n 1))b(strcat xrefname"$*$"layername))(setq n 0)(while(and(< n(length loclst))(not flag))(setq a(nth n loclst))(if(wcmatch a b)(setq flag a))(setq n(+ n 1)))(setq n 0)(while(and(< n(length loclst))(not flag))(setq a(nth n loclst))(if(equal a layername)(setq flag a))(setq n(+ n 1)))flag)(defun acet-blocktoxref-apply-xref-layer-props(lalst origlays laymap / la a)(setq lalst(mapcar 'xstrcase lalst)origlays(mapcar 'xstrcase origlays))(foreach la lalst(if(and(setq a(assoc la lamap))(not(member(cadr a)origlays)))
(acet-blocktoxref-copy-layer-props(car a)(cadr a)))))(defun acet-blocktoxref-copy-layer-props(la la2 / a b e1 e2 gc gclst)(setq e1(entget(tblobjname"layer"la))e2(entget(tblobjname"layer"la2))a(cdr(assoc 70 e2))a(logand a(+ 16 32))b(cdr(assoc 70 e1))e2(subst(cons 70(logior a b))(assoc 70 e2)e2)gclst(list 62 6 290 370 390))(foreach gc gclst(if(setq a(assoc gc e1))(progn(if(and(= gc 6)(setq b(xstrcase(cdr a)))(wcmatch b"*$*$*")(or(wcmatch b"*$#$*")(wcmatch b"*$##$*")(wcmatch b"*$###$*"))(setq b(last(acet-str-to-list"$"b)))(/= b"")(or(tblobjname"ltype"b)(progn(acet-safe-command T T(list"_.ltype""_load"b"acad.lin"""))(tblobjname"ltype"b))))(setq a(cons(car a)b)))(setq e2(subst a(assoc gc e2)e2)))))(entmod e2))(defun acet-block-referenced-tables-purge(tblst / gclst lst x gcode tbl name)(setq gclst '((2 . "block")(3 . "dimstyle")(8 . "layer")(6 . "ltype")(7 . "style")))(princ"\n清理中...")(princ"\n")(repeat 2 	(foreach x gclst(setq gcode(car x)tbl(cdr x)lst(cdr(assoc gcode tblst)))
(foreach name lst(if(or(/= gcode 8)(and(/="0"name)(not(acet-str-equal"DEFPOINTS"name))))(acet-table-purge tbl name T)))))(princ"完成。\n"))(defun acet-block-referenced-tables(bna tblst / na e1)(if(not tblst)(setq tblst(list '(8)			(list 2 bna)		 '(7)			 '(3)			 '(6)			)))(setq na(tblobjname"block"bna)e1(entget na))(while(and(setq tblst(acet-block-referenced-tables-ent e1 tblst))(setq na(entnext na))(setq e1(entget na))))tblst)(defun acet-block-referenced-tables-ent(e1 tblst / n lst a gcode tp lst2 b)(setq tp(cdr(assoc 0 e1)))(setq n 0)(repeat(length tblst)(setq lst(nth n tblst)gcode(car lst))(if(setq a(cdr(assoc gcode e1)))(progn(cond((= gcode 3)(if(and(/= tp"DIMENSION")(/= tp"TOLERANCE")(/= tp"LEADER"))(setq lst nil)(progn(if(= tp"DIMENSION")(progn(setq lst2(assoc 2 tblst)b(cdr(assoc 2 e1)))(if(not(member b lst2))(setq tblst(acet-block-referenced-tables		 b tblst)tblst(acet-list-assoc-append(list 2 b)tblst)	)))))))((and(= gcode 2)(not(member a lst)))(if(/= tp"INSERT")(setq lst nil)
(setq tblst(acet-block-referenced-tables a tblst)))))(if(and lst(not(member a lst)))(setq tblst(acet-list-assoc-append(list gcode a)tblst)))))(setq n(+ n 1)))tblst)(defun acet-block-replace(bna bna2 / flt ss n j na e1 lst)(setq flt(list '(0 . "INSERT")(cons 2 bna))ss(ssget"_x"flt))(setq j 0)(if ss(progn(setq n 0)(repeat(sslength ss)(setq na(ssname ss n)e1(entget na)e1(subst(cons 2 bna2)(assoc 2 e1)e1))(if(entmod e1)(setq j(+ j 1)))(setq n(+ n 1)))))(setq lst(bns_blktbl_match flt))(setq n 0)(repeat(length lst)(setq na(car(nth n lst))e1(entget na)e1(subst(cons 2 bna2)(assoc 2 e1)e1))(if(entmod e1)(setq j(+ j 1)))(setq n(+ n 1)))j)(princ)
