(求助）各位大神以下递增复制源码为什么在CAD2021里面呈现的效果不一样呢？
递增复制源码：出自哪位大神杰作不祥（目前出现的问题就是，在CAD2007可以用，不知道为什么高版本后的用这个递增的方式变了）请问有没有哪位大神可以出手帮忙解决一下，让其07和高版本都能兼容(vl-load-com)
(defun c:ct( / *Num* *wxs* );; Global-AssCnlc Global-AssEn24 Global-AssEn26 Global-Keyrege Global-Text-IO Global-ss *n-n*
(setvar "cmdecho" 0)
(setvar "DIMZIN" 1)
;;定义字符集
(setq Global-AssCnlc '("一" "二" "三" "四" "五" "六" "七" "八" "九" "十" ))
(setq Global-AssEn24 '("Z" "A" "B" "C" "D" "E" "F" "G" "H" "J" "K" "L" "M" "N" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y"))
(setq Global-AssEn26 '("Z" "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y"))
(setq Global-Keyrege "([一二三四五六七八九十])+|([\\u4e00-\\u9fa5])+|(+|+|(\\W]\\d+\\.\\d+)|(\\d+)|+|+|(\\W)+")
(setq Global-Text-IO "0");;文本是否包括IO
(setq *Num* 1)
(setq ver (atoi (getvar "acadver")) ssver (strcat "acetutil.x64." (itoa ver) ".arx"))
(and (null acet-ss-drag-move)(findfile ssver)(arxload ssver))
(and
(setq Global-ss (ssget ":L"));;是否有选择集'((0 . "TEXT"))
(setq *xtype* (Treatment_Text Global-ss))
(if (> (length *xtype*) 1);;是否选择了多于1个文本
(if (apply '= (mapcar '(lambda(x)(apply 'strcat x))*xtype*)) t (progn(princ "\n所选文字结构不同")nil));;结构是否相同
t)
;;*step* 表，步长值，文字改变后，步长值将发生变化。
;;*xtype* 记录文本的分段类型
(setq *step* (mapcar '(lambda(x) "0") (car *xtype*))
*step* (reverse (cons "1" (cdr (reverse *step*)))))
(while (progn
(initget "S ")
(setq Global-Pt1 (getpoint "\n 请指定基点或 [设置(S)]/<退出>:"))
(cond
((= Global-Pt1 "S")(Load_IDE_DCL)) ;;加载设置对话框
((=(length Global-Pt1)3)(Increasing_Move_copy)) ;;获取下一点
(t nil)
)
))
)
(setq *firstrun* t)
(setvar "cmdecho" 1)
(princ)
)
(defun Increasing_Move_copy( / en1 pt1 info)
(while (progn
(setq en1 (entlast)
info (strcat "\n第 " (itoa (setq *Num* (1+ *Num*))) " 点/<退出>:"))
(initget " ") ;;接受回车空输入
(setq pt1
(if acet-ss-drag-move
(acet-ss-drag-move Global-ss Global-Pt1 info 1)
(getpoint info)
))
(if pt1 (progn
(setq oldosmode (getvar "osmode"))
(setvar "osmode" 0)
(command "_copy" Global-ss "" Global-Pt1 Pt1)
(setvar "osmode" oldosmode)
(setq Global-ss (Change_Select_ss (get_entlast_command en1))
Global-Pt1 pt1))
)
)) nil
)
(defun get_entlast_command(en / ss)
(setq ss (ssadd))
(while (setq en (entnext en))(ssadd en ss))
ss
)
(defun Change_Select_ss(ss / n en txt dxf xx)
(setq n 0)
(repeat (sslength ss)
(if (setq txt (apply 'strcat (Change_Select_ent ss n)))
(setq dxf (entget (ssname ss n))
en (subst (cons 1 txt)(assoc 1 dxf)dxf)
xx (entmod en))
)
(setq n (1+ n))
) ss
)
(defun Change_Select_ent(ss n / new s1 s2 yy4)
(if (and ss (setq s1 (ssname ss n))(= "TEXT" (cdr (assoc 0 (entget s1)))))
(progn
(setq s2 (cdr (assoc 1 (entget s1))))
(foreach xx (mapcar 'list (car *xtype*) *step* (xcc-List s2 Global-Keyrege)) ;;类型、步长、数据
(cond
((= (car xx) "整数") ;;整数-最简单的递增
(setq yy4 (abs(+ (atoi (cadr xx)) (atoi (caddr xx))));;递增
new (cons (Add_zero_length (caddr xx) (itoa yy4)) new));;递增后更新表
)
((= (car xx) "小数");;需要考虑原来小数的位数，递增后保持一致
(setq y3 (caddr xx))
(or *wxs* (setq *wxs* (- (strlen y3)(vl-string-position 46 y3) 1))) ;;当前行小数的位数
(setq yy4 (abs (+ (atof (cadr xx)) (atof y3)))
new (cons (Add_zero_length (caddr xx) (rtos yy4 2 *wxs*)) new))
)
((= (car xx) "字母");;先转化为10进制，再进行递增运算
(setq skey (if (= Global-Text-IO "1") Global-AssEn24 Global-AssEn26)
yy4 (Change10toN (abs(+ (atoi (cadr xx)) (ChangeNto10 (caddr xx) skey))) skey)
yy4 (if (wcmatch (caddr xx) "~*[~A-Z]*") yy4 (strcase yy4 t));;大小写 bug 修正， hehoubin
new (cons yy4 new))
)
((= (car xx) "小写汉字")
(setq skey Global-AssCnlc
yy4 (Change10toN (abs(+ (atoi (cadr xx)) (ChangeNto10 (caddr xx) skey))) skey)
new (cons yy4 new))
)
(t (setq new (cons (caddr xx) new)))
)
)
)
) (reverse new)
)
(defun Add_zero_length(old new)
(while (> (strlen old) (strlen new))(setq new (strcat "0" new)))
new
)
(defun Load_IDE_DCL( / );;dcl_id txt Ltxt n
(setq dcl_id (load_dialog "xcc.dcl") n 0);;加载对话框
(if (not (new_dialog "xcc" dcl_id))(exit)) ;;激活对话框
(while (null (setq txt (cdr (assoc 1 (entget (ssname Global-ss n)))))) ;;避免设置窗口弹出错误
(setq n (1+ n)))
(setq Ltxt (Change_Select_ent Global-ss n) *n-n* n)
(set_tile "F01" txt)
(set_tile "F02" (apply 'strcat Ltxt))
(FillTxtList (xcc-List txt Global-Keyrege) "F03")
(FillTxtList Ltxt "F04")
(set_tile "F05" "0")
(or *firstrun* (set_tile "Y23" "欢迎使用"))
(mode_tile "F06" 1)
(set_tile "F07" Global-Text-IO)
(action_tile "F07" "(setq Global-Text-IO $value)")
(action_tile "F08" "(update_click_stp)") ;;更新步长
(action_tile "F03" "(Double_click_left_list $reason)") ;;左列表事件
(action_tile "F04" "(Double_click_right_list $reason)") ;;右列表事件
(setq UIreturn (start_dialog))
(unload_dialog dcl_id) t
)
(defun xcc-List(pa pb / mat L RegObj)
(setq RegObj (vlax-create-object "vbscript.regexp"))
(vlax-put-property RegObj 'Global 1)
(vlax-put-property RegObj 'Pattern pb)
(setq mat (vlax-invoke RegObj 'Execute pa))
(vlax-for x mat (setq L (cons (vla-get-value x) L)))
(reverse L)
)
(defun FillTxtList(x key)
(start_list key)
(mapcar 'add_list x)
(end_list)
)
(defun Treatment_Text(ss / n s1 s2 s3 s4 s5 s6)
(setq n 0)
(while (and ss (setq s1 (ssname ss n)))
(if (member '(0 . "TEXT")(setq s2 (entget s1)))
(setq s3 (cdr (assoc 1 s2)) ;;文本
s4 (xcc-List s3 Global-Keyrege)
s5 (mapcar '(lambda(x)(Chinese_Text_wcmach x)) s4)
s6 (cons s5 s6))
)(setq n (1+ n))
) (reverse s6)
)
(defun Chinese_Text_wcmach(txt)
(cond
((wcmatch txt "~*[~0-9]*") "整数")
((wcmatch txt "~*[~.0-9]*") "小数")
((wcmatch txt "~*[~A-Z],~[~a-z]*")"字母")
((xcc-List txt "[一二三四五六七八九十]+") "小写汉字")
(t "不能递增")
)
)
(defun Double_click_left_list(n / y1 L)
(setq y1 (atoi(get_tile "F03"))) ;;获取当前点击的位置，第一个是 0
(set_tile "F05" (setq y2 (nth y1 *step*)));;获取步长
(set_tile "F06" (nth y1 (car *xtype*)))
(if (= n 4)(progn
(FillTxtList (setq L(Change_Select_ent Global-ss *n-n*)) "F04") ;;更新右侧列表盒
(set_tile "F04" (itoa y1))
(set_tile "F02" (apply 'strcat L)) ;;更新合并文本框
))
)
(defun Double_click_right_list(n)
(if (= n 4)(set_tile "F03" (get_tile "F04")))
)
(defun update_click_stp( / y1 L)
(setq y1 (atoi(get_tile "F03"))) ;;获取当前点击的位置，第一个是 0
(setq *step* (UdListn y1 (get_tile "F05") *step*)) ;;*step*全局变量
(FillTxtList (setq L(Change_Select_ent Global-ss *n-n*)) "F04") ;;更新右侧列表盒
(set_tile "F04" (itoa y1))
(set_tile "F02" (apply 'strcat L))
)
(defun ChangeNto10(V K / L Lv N m sum x val)
(setq N (length K) ;;进制位 N
Lv (xcc-List (strcase V) ".")
L Lv m 0 sum 0) ;;循环变量
(if (apply 'and (mapcar '(lambda(x)(member x K)) Lv)) ;;容错处理，防止V里有不存在字符集的字
(repeat (length Lv)
(setq x (car (reverse L))
L (reverse (cdr (reverse L)))
val (- N (length (member x K)))
val (if (= val 0) N val)
val (* (expt N m) val)
sum (+ sum val)
m (1+ m))
) (setq sum -1))
sum
)
(defun Change10toN(S K / N ss x)
(setq N (length K) ss "") ;;进制位 N
(if (= (rem S N) 0)(setq S (- S N)))
(if (= 0 S)(setq ss (car K)))
(while (> S 0)
(setq ss (strcat (nth (rem S N) K) ss)
S (/ S N))
) ss
)
(defun UdListn(n v L / m)
(setq m -1)
(mapcar '(lambda(x)(setq m(1+ m))(if (= n m) v x))L)
)
(princ "递增复制+ v1.03 已加载")
(princ)
(command "shortcutmenu" 0)
(defun do_alloc (/ old_allod new_alloc)
(setq old_alloc (alloc 2000)
new_alloc (alloc 2000)
)
(expand (1+ (/ 11500 new_alloc)))
(alloc old_alloc)
)
(do_alloc)
(setq do_alloc nil)
3年了还是无解
页:
[1]