一个命令不切换，递增复制，阵列递增，阵列填满三合一

wzg356

对话框里面有阵列数，则进行阵列递增 含阵列布满
对话框已设置数据有效性检查
只有一行的多行文字也行

;末尾字母加(strendisabc+ "az" 2)
(defun strendisabc+(str n / s2 as0 as2)
(if (wcmatch str "*[a-zA-Z]")
  (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);递增复制
   )
   
  )   
)
)

sunny_8848

wzg356 发表于 2021-4-22 19:59
确实没搞懂你的执行，也许你的对象不是text或mtext。
你用命令Mtext 或text 打一行字然后再dzco 看看

还是不行。我上传的附件(没有源代码版本)也是针对text文本，前后有空格都不能正确执行。您的附件就不行，不知道是不是CAD 2010版本的问题

wzg356

sunny_8848 发表于 2021-4-22 08:36
复制功能挺好用的，就是阵列阵列数和阵列布满不知道怎么用，老是出来一个结果对象

没有阵列数，只执行一般的递增复制
有阵列数，不钩布满，则沿基点--》第二点方向阵列相应数量
有阵列数，钩布满，则沿基点--》第二点之间阵列相应数量

wzg356

sunny_8848 发表于 2021-4-22 19:37
附图是我在论坛下载的一个递增复制，两个对象之间的距离是选择的基点和参考点间距离，然后往后拉就行了，不 ...

确实没搞懂你的执行，也许你的对象不是text或mtext。
你用命令Mtext 或text 打一行字然后再dzco 看看

panliang9

谢谢楼主分享。

yoyoho

谢谢! wzg356分享程序!!!!!

999999

谢谢楼主分享程序

hqu8808

贴上动图更棒

sunny_8848

复制功能挺好用的，就是阵列阵列数和阵列布满不知道怎么用，老是出来一个结果对象

lxl217114

感谢分享

fundoll

效果试不出来

sunny_8848

wzg356 发表于 2021-4-22 12:47
没有阵列数，只执行一般的递增复制
有阵列数，不钩布满，则沿基点--》第二点方向阵列相应数量
有阵列数 ...

还是只有一个对象