一个命令不切换，递增复制，阵列递增，阵列填满三合一
本帖最后由 wzg356 于 2021-4-28 22:57 编辑对话框里面有阵列数，则进行阵列递增 含阵列布满
对话框已设置数据有效性检查
只有一行的多行文字也行
;末尾字母加(strendisabc+ "az" 2)
(defun strendisabc+(str n / s2 as0 as2)
(if (wcmatch str "*")
(progn
(setq s2 (substr str (strlen str)) n(fix n))
(setq as0 (ascii s2) as2(+ (ascii s2) n))
(cond
((and(>= as0 97)(< as2 97)) (setq s2 "z"))
((and(>= as0 65)(< as2 65)) (setq s2 "Z"))
((and(<= as0 122)(> as2 122)) (setq s2 "a"))
((and(<= as0 90)(> as2 90)) (setq s2 "A"))
(T (setq s2 (chr (+ (ascii s2) n))))
)
(strcat (substr str 1 (1- (strlen str))) s2)
)
)
)
(vl-load-com)
;末尾数字加
(defun strendisnum+(str n / s1 l)
(if (wcmatch str "*#")
(progn
(setq s1 "")
(while (not (numberp (vl-catch-all-apply 'read (list str))))
(setq s1 (strcat s1 (substr str 1 1)))
(setq str (substr str 2))
);多行文字可能只能读一行，失误
(setq l (strlen str) str(vl-princ-to-string (+ n (read str))))
(repeat(- l(strlen str))(setq str(strcat "0" str)))
(strcat s1 str)
)
)
)
;;图元文本加
(defun enText+ (ob n /str str1)
(and(wcmatch (vla-get-ObjectName ob)"*Text")
(setq str(vla-get-TextString ob))
(not(wcmatch str "*\\P*,*\n*,*\t*"))
(or (setq str1(strendisnum+ str n))(setq str1(strendisabc+ str n)))
(vla-put-TextString ob str1)
)
)
;为了三种递增方案合一，增加对话框
;通过对话框设置参数(set_dzcodate)
(defun set_dzcodate ( / get_date checkdata lst_str str file f dcl_id dd ls)
(setq lst_str '(
"dzcodcl:dialog {label = \"参数设置\" ;"
" :edit_box {key = \"key1\" ;label = \"递增 步距 \" ;}"
" :edit_box {key = \"key2\" ;label = \"阵列数(>1)\" ;}"
" :toggle {key = \"key3\" ;label = \"阵列布满\" ;}"
" ok_cancel;"
" :text {label = \"阵列数有效则执行阵列递增\" ;}"
" :text {label = \"by QQ1047048660\" ;}}"
)
)
(setq file (vl-filename-mktemp "DclTemp.dcl"))
(setq f (open file "w"))
(foreach str lst_str(princ "\n" f)(princ str f))
(close f)
(defun get_date ()(mapcar 'get_tile(list "key1" "key2" "key3")))
(defun checkdata(ls / b)
(and(numberp(read(car ls)))
(or(and(not(setq b(read(cadr ls))))(= "0" (caddr ls)))
(and(numberp b)(= b (fix b))(> b 1))
)
)
)
(setq dcl_id (load_dialog file))
(new_dialog "dzcodcl" dcl_id "3" Pset_dzcodate)
(mapcar '(lambda (x y) (set_tile x y))(list "key1" "key2" "key3")(list "1" "" "0"))
(action_tile "accept"
(strcat "(if (checkdata(setq ls(get_date)))"
"(setq Pset_dzcodate(done_dialog 1))(alert \"输入非法！\"))"
)
)
(setq dd (start_dialog))
(unload_dialog dcl_id)
(vl-file-delete file);删除临时dcl文件
(if(= 1 dd) ls)
)
;普通递增复制 ，利用飞诗帖子优化改造
;ss 选择集 p基点 n递增数
(setq *doc* (vla-get-ActiveDocument (vlax-get-acad-object)))
(defun dzCopy (ss p n / *error* ss2enls la e p1)
(defun *error* (msg)
(mapcar 'entdel (ss2enls ss))
(vla-EndUndoMark *doc*)
)
(defun ss2enls(ss / x)
(setq ss(mapcar 'cadr (ssnamex ss)))
(vl-remove-if '(lambda(x)(/= (type x) 'ENAME))ss);变图元名表
)
(setvar "cmdecho" 0)
(while t
(setq la (entlast))
(foreach e (ss2enls ss)
(enText+ (vla-copy(vlax-ename->vla-object e)) n)
)
(setq ss (ssadd))
(while (setq la(entnext la))(setq ss(ssadd la ss)))
(setq p1 p)
(command ".move" ss "" "non" p1 "\\");@就是最近的那个点
(if (equal p1 (setq p(getvar "lastpoint")) 1e-8) (exit))
)
(vla-EndUndoMark *doc*)
)
;阵列递增
;ss 选择集 p基点 n1递增数 n2阵列数 af布满标记
(defun dzCopya (ss p n1 n2 af / *error* e k i)
(defun *error* (msg)(setvar "cmdecho" 1))
(setvar "cmdecho" 0)
(setq e (entlast) k(sslength ss) i -1)
(if(= "1" af)
(command"_copy" ss "" "non" p "a" n2 "f" pause)
(command"_copy" ss "" "non" p "a" n2 pause)
)
(while (setq e(entnext e))
(enText+ (vlax-ename->vla-object e) (* (1+(fix(/(setq i(1+ i))k))) n1))
)
(setvar "cmdecho" 1)
)
;;主程序
;阵列递增，普通递增复制三合一
(defun c:dzco( / ss p ls n1 af n2)
(princ "\n 文字为一行,尾部为数字或字母,递增复制3个方案!")
(if (and(setq ss (ssget))(sssetfirst nil ss)
(setq p(getpoint "\n 指定基点:"))
(setq ls(set_dzcodate));对话框设置参数
)
(progn
(setq n1(read(car ls)) af(caddr ls))
(if(= n1(fix n1))(setq n1(fix n1)))
(princ "\n 指定下一点：")(sssetfirst)
(if(setq n2(read (cadr ls)))
(dzCopya ss p n1 n2 af);阵列递增
(dzCopy ss p n1);递增复制
)
)
)
)
wzg356 发表于 2021-4-22 19:59
确实没搞懂你的执行，也许你的对象不是text或mtext。
你用命令Mtext 或text 打一行字然后再dzco 看看
还是不行。我上传的附件(没有源代码版本)也是针对text文本，前后有空格都不能正确执行。您的附件就不行，不知道是不是CAD 2010版本的问题 sunny_8848 发表于 2021-4-22 08:36
复制功能挺好用的，就是阵列阵列数和阵列布满不知道怎么用，老是出来一个结果对象
没有阵列数，只执行一般的递增复制
有阵列数，不钩布满，则沿基点--》第二点方向阵列相应数量
有阵列数，钩布满，则沿基点--》第二点之间阵列相应数量 sunny_8848 发表于 2021-4-22 19:37
附图是我在论坛下载的一个递增复制，两个对象之间的距离是选择的基点和参考点间距离，然后往后拉就行了，不 ...
确实没搞懂你的执行，也许你的对象不是text或mtext。
你用命令Mtext 或text 打一行字然后再dzco 看看 谢谢楼主分享。 谢谢! wzg356分享程序!!!!! 谢谢楼主分享程序
贴上动图更棒 复制功能挺好用的，就是阵列阵列数和阵列布满不知道怎么用，老是出来一个结果对象 感谢分享 :L效果试不出来 wzg356 发表于 2021-4-22 12:47
没有阵列数，只执行一般的递增复制
有阵列数，不钩布满，则沿基点--》第二点方向阵列相应数量
有阵列数 ...
还是只有一个对象