让refedit对付无名块（鼠标双击块）程序还在调试中

liu22737

(setvar "cmdecho" 0)(prompt "\n")(vl-cmdf "unDEFINE" "refedit")(prompt "\n更改\"refedit\"处理无名块")
(defun c:refedit(/ ss a0 s1 s2 s3 a1 a2 a3 b0 b1 b2 blks flt doc bn oldname newname new_name
    LOOP p1 i var_xp newBlkDef lis_0 lis_1 lis_2 lsx_oldvars lsx_newerr)
(setvar "cmdecho" 0)
(if(= ""(getvar "refeditname"))(progn(VL-LOAD-COM)
;;;;;;;;;;;;;;;;;;;;;----------------------
(defun lsx_newerr(msg / i a)
  (setq *error* lsx_olderr)
  (mapcar 'setvar '("qaflags" "cmdecho" "osmode" "EXPERT" "luprec" "DBLCLKEDIT")lsx_oldvars)
  (command"undo""e")(command"u")(princ)
  );endlsx_newerr
;;;;;;;;----------------------------------------
(command "undo" "be")
(setq lsx_olderr *error* *error* lsx_newerr lsx_oldvars(mapcar 'getvar '("qaflags" "cmdecho" "osmode" "EXPERT" "luprec" "DBLCLKEDIT")))
(mapcar 'setvar '("cmdecho" "osmode" "EXPERT" "luprec" "DBLCLKEDIT")'(0 0 0 0 1));(setvar"DBLCLKEDIT"1)
;;;;;;;;---------------------------
;(setq LOOP t a1 nil s1(ssget ":s" '((0 . "INSERT"))))
(setq LOOP t a1 nil s2(nentsel)s1(ssadd)s1(ssadd(last(last s2))s1)s3(cdr(assoc 0(entget(car s2)))))
   (setq a0(car(last s2))
  oldname(cdr(assoc 2(entget a0)))
  newname(strcat"$u"(substr(rtos(getvar "cdate")2 6)10 6)));setq
(while LOOP(if(not(tblsearch "block"(setq newname(strcat"$u"(rtos(+(read(vl-string-left-trim "$u"newname))1)2 0)))))(setq LOOP nil)));while
(if(=(vl-string-position 42 oldname)0);判断无名块,改名
  (progn
   (setq b0(vlax-ename->vla-object a0)
  doc(vla-get-activedocument(vlax-get-acad-object))
  blks(vla-get-blocks doc)
  b1(vla-item blks oldname)
  b2(vla-get-origin b1)
  newBlkDef(vla-add blks b2 newname)lis_0 '());setq
  (vlax-for obj b1(setq lis_0(cons obj lis_0)))
  (setq sArray(vlax-safearray-fill(vlax-make-safearray vlax-vbobject(cons 0(1-(length lis_0))))lis_0))
  (vla-copyobjects doc sArray newBlkDef nil)
  (setq a1(entget a0))
  (setq a1(subst(cons 2 newname)(assoc 2 a1)a1)a1(subst(cons 70 0)(assoc 70 a1)a1))
;(if(not(entmod a1))(setq a1 nil));if
  ));if;判断无名块且改名结束
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;-----------块替换,嵌套块替换
  (if a1(progn(entmod(entget(last(last s2))))
    (setq new_name(assoc 2 a1)i 0 flt(list(cons 0 "INSERT")(cons 2(strcat"`" oldname)))ss(ssget"x" flt))
    (if ss(repeat(sslength ss)
   (setq a2(ssname ss i)i(1+ i)a2(entget a2)a2(subst new_name(assoc 2 a2)a2));setq
   (entmod a2)
     );repeat
     );if;ss
;(setq bbb(getvar "cdate"))
  ;(if(not bns_blktbl_match)(progn;ET工具
     (setq ss(ssget"_x"'((0 . "INSERT")))i 0 lis_0'()lis_1'())
  (repeat(sslength ss)
     (setq a2(entget(ssname ss i))i(1+ i)
   ;hd(cdr(assoc 5 a2));取消再生
    bn(cdr(assoc 2 a2))
    bn(TblSearch "BLOCK" bn)
    bn(Cdr(assoc -2 bn)));setq
     (while bn
       (if(setq a3(entget bn))
        (if(=(cdr(assoc 0 a3))"INSERT")
   (if(=(cdr(assoc 2 a3))oldname);(progn
     (entmod(subst new_name(assoc 2 a3)a3))
     ;(if(not(vl-position hd lis_0))(setq lis_0(cons hd lis_0)));if;取消再生
     ;);progn
     (if(not(vl-position(cdr(assoc 2 a3))lis_1))(setq lis_1(cons(cdr(assoc 5 a3))lis_1)));if;lis_0(cons hd lis_0)
    );if;vl
         );if;=
        );if;setq
       (setq bn(entnext bn))
      );while;bn
   );repeat
   (while(/= 0(length lis_1))(setq i 0 lis_2'())
       (repeat(length lis_1)
   (setq a3(handent(nth i lis_1)))
      (while bn
     (if(setq a3(entget bn))
       (if(=(cdr(assoc 0 a3))"INSERT")
    (if(=(cdr(assoc 2 a3))oldname)
      (entmod(subst new_name(assoc 2 a3)a3))
      (if(not(vl-position(cdr(assoc 2 a3))lis_2))(setq lis_2(cons(cdr(assoc 5 a3))lis_2)));if
     );if;vl
           );if;=
     );if;setq
    (setq bn(entnext bn))
   );while;bn
       );repeat
      (setq lis_1 lis_2)
    );while
  ;(setq i 0)
  ;(if(/= 0(length lis_0))(repeat(length lis_0)(entmod(entget(handent(nth i lis_0))))(setq i(1+ i))));if;取消再生
;     );progn
;     (progn
; (setq lis_0(bns_blktbl_match flt)i 0)
; (repeat(length lis_0)
;   (setq a3(car(nth i lis_0))i(1+ i)
;  a3(entget a3)
;  a3(subst new_name(assoc 2 a3)a3));setq
;   (entmod a3)
;  );repeat
; (setq i 0 ss(ssget"_x"(list(cons 2(cadadr lis_0)))))
; (repeat(sslength ss)(entmod(entget(ssname ss i)))(setq i(1+ i)));repeat
;   ));progn;if;ET工具
  ));progn;if;(entmod a1)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;-----------块替换,嵌套块替换 end
;(setq bbb(-(getvar "cdate")bbb))
;;;还原命令REFEDIT
(setq *error* lsx_olderr)
(mapcar 'setvar '("qaflags" "cmdecho" "osmode" "EXPERT" "luprec" "DBLCLKEDIT")lsx_oldvars)
(command"undo""e")(princ)
(vl-cmdf "REDEFINE""refedit");(initdia)
;(vl-cmdf "refedit"(osnap(trans(cadr(last(car(ssnamex s1))))0 1)"nea"));(while(/="" (getvar "refeditname"))(command"delay"1000))
(if(or(= s3 "TEXT")(= s3 "MTEXT")(= s3 "ATTRIB")(= s3 "ATTDEF"))
  (progn(sssetfirst nil s1)(vl-cmdf "refedit"))
  (vl-cmdf "refedit"(osnap(trans(cadr s2)0 1)"nea"))
   );if
(vl-cmdf "unDEFINE""refedit")
);progn
((setq a1(entsel))(princ(strcat"\n** 不允许使用该命令,"(getvar "refeditname")"已经提取用于编辑 **"))));if
(princ)
);end

dingtiedt

楼主辛苦写这么长，是不是想不需要输入“refedit”，直接编辑无名块。几年了，还不知道还有更新吗

chenry676

这个很好用

chenry676

这几次为何我双击后死机并且出错？能否帮我看看？

chenry676

dingtiedt 发表于 2015-8-4 17:52
楼主辛苦写这么长，是不是想不需要输入“refedit”，直接编辑无名块。几年了，还不知道还有更新吗

主要是针对无名块，前几次可用，这几次死机，不知道什么原因。

guankuiwu

学习中。。。

树櫴希德

dingtiedt 发表于 2015-8-4 17:52
楼主辛苦写这么长，是不是想不需要输入“refedit”，直接编辑无名块。几年了，还不知道还有更新吗

refedit无法编辑无名块