liu22737 发表于 2013-9-28 10:45:29

增强aidimprec命令

;;;;;;;;;;;;;;;;;
(defun dim-acc(acc / i a1 a2 a3 b1 s1 s2 s3 ss sa lis xx lsx_olderr lsx_newerr)
(setq s3(cadr(ssgetfirst))ss(ssadd)lis nil s2 t)
;;(defun lsx_newerr(msg)(setq *error* lsx_olderr)(command "undo" "e")(princ));endlsx_newerr
;;(setq lsx_olderr *error* *error* lsx_newerr)
;;(command "undo" "be")
(while(or s2 s1)(setq s2 nil)
(if s3(progn(sssetfirst nil s3)(setq s1(ssget"p"'((0 . "DIMENSION")))))(progn(setq s2(ssget":s"))(if s2(setq s1(ssget"p" '((0 . "DIMENSION"))))(setq s1 nil))))
(if s1(progn
      (setq i 0 sa(ssadd))
      (repeat(sslength s1);搜集原尺寸精度
        (setq a1(ssname s1 i)i(1+ i))
        (if(ssmemb a1 ss)(setq sa(ssadd a1 sa))
             (if(setq a2(cdadr(assoc -3(entget a1 '("ACAD"))))a3(vl-position(cons 1070 271)a2))
                (setq xx(cdr(nth(1+ a3)a2))lis(cons(cons a1 xx)lis)ss(ssadd a1 ss))
                (setq xx(cdr(assoc 271(tblsearch"DIMSTYLE"(cdr(assoc 3(entget a1))))))lis(cons(cons a1 xx)lis)ss(ssadd a1 ss)));if
          );if        );if
        );repeat(sslength s1)
    (VL-CMDF"aidimprec"acc s1"");强制变更尺寸精度
    (setq i 0)(repeat(sslength sa)(setq a1(ssname sa i)i(1+ i)b1(assoc a1 lis)lis(vl-remove b1 lis)ss(ssdel a1 ss))(VL-CMDF"aidimprec"(itoa(cdr b1))a1""));两次点选原尺寸还原
    (setq s2 nil s3 nil);(if s3(exit))
    );progn
(if s2(progn;处理引线及炸散尺寸
        (setq a1(entget(ssname s2 0))a2(cdr(assoc 0 a1)))
        (if(or(="MTEXT"a2)(="TEXT"a2))(progn
                (setq a2(cdr(assoc 1 a1))a3(vl-string->list(vl-string-subst"%%C"(vl-list->string '(92 85 43 50 50 48 53 ))(strcat"AA"a2".AA")))
                        sa"." i 1 b1(vl-position 46 a3)xx(and(>(nth(1+ b1)a3)47)(<(nth(1+ b1)a3)58)))
                (while xx(setq sa(strcat sa(vl-list->string(list(nth(+ b1 i)a3))))i(1+ i)xx(and(>(nth(+ b1 i)a3)47)(<(nth(+ b1 i)a3)58))));whil
                (setqxx(and(>(nth(1- b1)a3)47)(<(nth(1- b1)a3)58))i 1)
                (while xx(setq sa(strcat(vl-list->string(list(nth(- b1 i)a3)))sa)i(1+ i)xx(and(>(nth(- b1 i)a3)47)(<(nth(- b1 i)a3)58))));whil
                (setq b1(strlen(substr sa(+(vl-string-position 46 sa)2))))
                (if(<(atoi acc)b1)(progn
                        (setq s3(vl-string-subst(rtos(atof sa)2(atoi acc))sa a2))
                        (entmod(subst(cons 1 s3)(assoc 1 a1)a1))
                  ));if
          ));if
    ));if
);if
);while
;;(setq *error* lsx_olderr)
;;(command "undo" "e")
(princ)
);end
(defun c:d0()(dim-acc "0"))
(defun c:d1()(dim-acc "1"))
(defun c:d2()(dim-acc "2"))
(defun c:d3()(dim-acc "3"))

清风明月名字 发表于 2013-9-28 12:51:04

谢谢楼主的分享！收藏备用。

Aguo 发表于 2014-6-5 23:14:48

楼主,怎么不做到5位精度呀,期待
页: [1]
查看完整版本: 增强aidimprec命令