- 积分
- 194
- 明经币
- 个
- 注册时间
- 2004-2-27
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
在论坛上下载表格删除0空格并重新编号这个插件，感觉非常好用，但加载后提示错误: no function definition: CX-REG-YN，换几个版本CAD也如此，查询翻译应该是有自定义函数不能加载。打开插件第一条命令出现了，不知如何解决，请教大佬大神帮助，谢谢！
源程序如下：
(defun c:a5 ( / a a1 aa b1 box ffx h1 i kk l1 l2 la lb lbg lc ld le lk ll lsn lss lx lxx ly odlst pc sn ss sty th tw x xx y y1 y2 dxf ss2lst ssbox ebox cbox mid 3d2d CurveLength lstcj qbw mkline mktext RevmoveMt2Text explodeblk cumid)(cx-reg-yn)
(progn
(defun cumid (e) (vlax-curve-getpointatdist e (* 0.5 (vlax-curve-getdistatpoint e (vlax-curve-getendpoint e)))))
(defun explodeblk(ent)
(mapcar 'vlax-vla-object->ename (vlax-safearray->list
(vlax-variant-value
(vla-explode(vlax-ename->vla-object ent)))))
)
(defun RevmoveMt2Text (MTextString / regex s)
(setq regex(vlax-create-object "Vbscript.RegExp")) ;引用正则表达式控件
(vlax-put-property regex "IgnoreCase" 0) ;不忽略大小写
(vlax-put-property regex "Global" 1) ;匹配方式，全文字匹配
(setq s MTextString)
;替换\\字符
(vlax-put-property regex "Pattern" "\\\\\\\\")
(setq s(vlax-invoke-method regex "Replace" s (chr 1)))
;替换\{字符
(vlax-put-property regex "Pattern" "\\\\{")
(setq s(vlax-invoke-method regex "Replace" s (chr 2)))
;替换\}字符
(vlax-put-property regex "Pattern" "\\\\}")
(setq s(vlax-invoke-method regex "Replace" s (chr 3)))
;删除段落缩进格式
(vlax-put-property regex "Pattern" "\\\\pi(.[^;]*);")
(setq s(vlax-invoke-method regex "Replace" s ""))
;删除制表符格式
(vlax-put-property regex "Pattern" "\\\\pt(.[^;]*);")
(setq s(vlax-invoke-method regex "Replace" s ""))
;删除堆迭格式
(vlax-put-property regex "Pattern" "\\\\S(.[^;]*)(\\^|#|\\\\)(.[^;]*);")
(setq s(vlax-invoke-method regex "Replace" s ""))
;删除字体、颜色、字高、字距、倾斜、字宽、对齐格式
(vlax-put-property regex "Pattern" "(\\\\F|\\\\f|\\\\C|\\\\H|\\\\\T|\\\\Q|\\\\W|\\\\A)(.[^;]*);")
(setq s(vlax-invoke-method regex "Replace" s ""))
;删除下划线、删除线格式
(vlax-put-property regex "Pattern" "(\\\\L|\\\\O|\\\\l|\\\\o)")
(setq s(vlax-invoke-method regex "Replace" s ""))
;删除不间断空格格式
(vlax-put-property regex "Pattern" "\\\\~")
(setq s(vlax-invoke-method regex "Replace" s ""))
;删除换行符格式
(vlax-put-property regex "Pattern" "\\\\P")
(setq s(vlax-invoke-method regex "Replace" s ""))
;删除换行符格式(针对Shift+Enter格式)
(vlax-put-property regex "Pattern" "\n")
(setq s(vlax-invoke-method regex "Replace" s ""))
;删除{}
(vlax-put-property regex "Pattern" "({|})")
(setq s(vlax-invoke-method regex "Replace" s ""))
;替换回\\,\{,\}字符
(vlax-put-property regex "Pattern" "\\x01")
(setq s(vlax-invoke-method regex "Replace" s "\\"))
(vlax-put-property regex "Pattern" "\\x02")
(setq s(vlax-invoke-method regex "Replace" s "{"))
(vlax-put-property regex "Pattern" "\\x03")
(setq s(vlax-invoke-method regex "Replace" s "}"))
(vlax-release-object regex)
s
)
(defun dxf (key ename) (cdr (assoc key (entget ename))))
(defun ss2lst ( ss / i l )
(if ss
(repeat (setq i (sslength ss))
(setq l (cons (ssname ss (setq i (1- i))) l))
)
)
)
(defun ssbox ( s / a b i m n o )
(repeat (setq i (sslength s))
(if
(and
(setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
(vlax-method-applicable-p o 'getboundingbox)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
)
(setq m (cons (vlax-safearray->list a) m)
n (cons (vlax-safearray->list b) n)
)
)
)
(if (and m n)
(mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
)
)
(defun ebox (ent / ll ur)
(vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur)
(mapcar 'safearray-value (list ll ur))
)
(defun CurveLength (ename)
(vlax-curve-getDistAtParam
ename
(vlax-curve-getEndParam ename)
)
)
(defun lstcj ( l1 l2 )
(vl-remove-if '(lambda ( x ) (member x l2)) l1)
)
(defun qbw (lst)
(reverse (cdr (reverse lst)))
)
(defun cbox (e) (apply 'mid (ebox e)))
(defun mid (p1 p2) (mapcar (function (lambda (e1 e2) (* (+ e1 e2) 0.5))) p1 p2))
(defun 3d2d (p) (mapcar '+ p '(0 0)))
(defun ScreenWinwow(/ h c)
(setq c(getvar'viewctr)
h(*(getvar'viewsize)0.5)
h(list(*(apply'/(getvar'screensize))h)h))
(mapcar'(lambda(x)(mapcar x c h))'(- +))
)
(setq *ACAD* (vlax-get-acad-object)
*DOC* (vla-get-ActiveDocument *ACAD*)
)
(defun *error*(msg)
(mapcar 'setvar '("cmdecho" "osmode" "dimzin") odlst)
(vlax-invoke-method *DOC* 'EndUndoMark)
(princ msg)
)
(vlax-invoke-method *DOC* 'StartUndoMark)
(setq odlst (mapcar 'getvar '("cmdecho" "osmode" "dimzin")))
(mapcar 'setvar '("cmdecho" "osmode" "dimzin") '(0 0 8))
(setq lst nil
ts (princ "\n选择全部表格:")
ss (ssget '((0 . "*text,line") (8 . "表格")))
)
)
(if ss
(progn
(setq lss (ss2lst ss)
l1 (vl-remove-if-not '(lambda(x) (wcmatch (dxf 0 x) "*TEXT")) lss)
l2 (vl-remove-if-not '(lambda(x) (= "LINE" (dxf 0 x))) lss)
l2 (vl-sort l2 '(lambda (x y) (< (CurveLength x) (CurveLength y)) ) )
th (apply 'min (mapcar '(lambda(x) (dxf 40 x)) l1))
h1 (* th 0.5)
ll (ScreenWinwow)
sty (dxf 7 (car l1))
tw (dxf 41 (car l1))
)
(while l2
(setq a (car l2)
box (mapcar '3d2d (ebox a))
box (list (mapcar '- (car box) (list h1 h1)) (mapcar '+ (cadr box) (list h1 h1)))
ffx t
)
(command "zoom" "w" (car box) (cadr box) "zoom" "0.9xp")
(while (and ffx (setq sn (ssget "c" (car box) (cadr box) '((0 . "*text,line") (8 . "表格")))))
(setq b1 (mapcar '3d2d (ssbox sn))
b1 (list (mapcar '- (car b1) (list h1 h1)) (mapcar '+ (cadr b1) (list h1 h1)))
)
(command "zoom" "w" (car b1) (cadr b1) "zoom" "0.9xp")
(if (equal b1 box th)
(setq ffx nil)
(setq box b1)
)
)
(setq lsn (ss2lst sn)
l2 (lstcj l2 lsn)
)
(if (> (length lsn) 2)
(progn
(setq la (vl-remove-if-not '(lambda(x) (wcmatch (dxf 0 x) "*TEXT")) lsn)
la (vl-sort la '(lambda (x y) (< (cadr (cbox x)) (cadr (cbox y))) ) )
lb nil
)
(while la
(setq a1 (car la);
lx (vl-remove-if-not '(lambda(x) (equal (cadr (cbox x)) (cadr (cbox a1)) (* th 0.4))) la)
lx (vl-sort lx '(lambda (x y) (< (car (cbox x)) (car (cbox y))) ) )
lb (cons lx lb);
la (lstcj la lx)
)
)
(setq i 0
lb (mapcar '(lambda(x) (cons (setq i (1+ i)) x)) lb)
ly (mapcar '(lambda(x) (cons (car x) (cadr (cbox (cadr x))))) lb)
lc (mapcar '(lambda(x)
(if (equal "0" (RevmoveMt2Text (dxf 1 (last x))))
(progn
(mapcar 'entdel (cdr x))
(list (car x))
)
x
)) lb)
ld (vl-remove-if-not '(lambda(x) (= 1 (length x))) lc)
)
(if ld
(progn
(setq ld (reverse ld))
(while ld
(setq a1 (car ld)
ld (cdr ld)
)
(setq l1 (member a1 lc)
y1 (cdar (vl-remove-if-not '(lambda(x) (= (car a1) (car x))) ly))
y2 (cdar (vl-remove-if-not '(lambda(x) (= (1- (car a1)) (car x))) ly))
)
(setq le (apply 'append (mapcar 'cdr (cdr l1))))
(foreach x le
(vla-move (Vlax-Ename->Vla-Object x) (vlax-3d-point (list 0 y1)) (vlax-3d-point (list 0 y2)))
)
)
(setq ld (vl-remove-if-not '(lambda(x) (and (entget x) (wcmatch (dxf 0 x) "*TEXT"))) lsn)
lxx (vl-remove-if-not '(lambda(x) (and (entget x) (wcmatch (dxf 0 x) "LINE"))) lsn)
lbg nil
)
(setvar "clayer" "表格")
(foreach aa ld
(command "_.boundary" "a" "b" "n" sn "" "" (cbox aa) "")
(setq kk (entlast)
lk (explodeblk kk)
)
(entdel kk)
(foreach xx lk
(if (not (vl-remove-if-not '(lambda(x) (equal x (setq pc (cumid xx)) (* th 0.1))) lbg))
(setq lbg (cons pc lbg))
(entdel xx)
)
)
)
(mapcar 'entdel lxx)
(setq ld (vl-remove-if-not '(lambda(x) (> (length x) 1)) lc))
(setq ld (mapcar 'cadr (cdr ld)))
(setq i 0)
(foreach aa ld
(Vlax-Put-Property (Vlax-Ename->Vla-Object aa) 'TextString (itoa (setq i (1+ i))))
)
)
)
)
)
);
(command "zoom" "w" (car ll) (cadr ll))
)
(princ "\n表格图层没对象被选择到:")
)
(mapcar 'setvar '("cmdecho" "osmode" "dimzin") odlst)
(vlax-invoke-method *DOC* 'EndUndoMark)
)
|
本帖子中包含更多资源
您需要 登录 才可以下载或查看，没有账号？注册
x
|
发表于 2021-11-21 22:23:03
置顶卡
变色卡
显身卡
楼主