求助，如何在下面这个阵列增值的源码中控制增量值，也就是步长，现在默认是增量1，...

注册

求助，如何在下面这个阵列增值的源码中控制增量值，也就是步长，现在默认是增量1，希望可以按需输入增量值
(defun c:d1(/ ss p1)
(if (setq ss (ssget":e:s") )
(progn
(setq p1 (cadr(grread 3)))
(LM:incarray nil ss 1 p1 p1)
(vl-cmdf "_move" (entlast) "" "non" p1 "\\")
)
)
)

(defun c:d2(/ ss p1 p2 x_x)
(defun x_x(ss)
(if (setq p1 (getpoint (strcat "\n 指定复制基点：（左键 + 右键 -）") ) )
(if (setq p2 (getpoint p1 (strcat "\n 指定阵列间距：") ) ) (LM:incarray t ss 1 p1 p2) )
(if (and (setq p1 (getpoint (strcat "\n 指定复制基点：（递减）") ) ) (setq p2 (getpoint p1 (strcat "\n 指定阵列间距：") ) ) ) (LM:incarray t ss -1 p1 p2) )
) )
(if (ssget"i") (setq ss (ssget"i")) (setq ss (ssget) ) )
(if ss (x_x ss) )
(vl-cmdf "undo" "be")
(princ))

                            阵列 对象 增量 基点 间距
(defun LM:incarray( d    ss    inc   bpt    vxu / *error* dim dis ept lst obl qty vxw)
     (defun *error* ( msg )
         (if (= 'int (type dim))
             (setvar 'dimzin dim)
         )
         (foreach obj obl
             (if (and (= 'vla-object (type obj)) (not (vlax-erased-p obj)) (vlax-write-enabled-p obj))
                 (vla-delete obj)
             )
         )
         (incarray:endundo (incarray:acdoc))
         (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
             (princ (strcat "\n Error: " msg))
         )
         (redraw) (princ)
     )
     (setq ER NIL)
   (setq ss (cadr (ssgetfirst)))
   (if (/= nil ss ) (progn
       (setq ent (ssname ss 0))(setq obj (vlax-ename->vla-object ent) nam (vlax-get-property obj "ObjectName"))
(if (wcmatch nam "*Db*Text")
   (progn
(if (= nam "TDbText")(command "explode" ss))
(setq ER "1")
         (setenv "LMac\\incarray" (incarray:num->str inc))
)
)
     )
   )
     (incarray:startundo (incarray:acdoc))
     (setq dim (getvar 'dimzin))
     (setvar 'dimzin 0)
     (cond
         (   (not
                 (and
                   (setq lst2 (ssget "p" '((0 . "~viewport"))))
                     (setq lst (incarray:selection->list lst2))
                     (progn
                         (while
                             (and
                              vxu
                                 (equal bpt vxu 1e-8)
                             )
                         )
                         vxu
                     )
(setq vxu (mapcar '- vxu bpt) vxw (trans vxu 1 0 t) dis (distance '(0.0 0.0 0.0) vxw) )
                 )
             )
         )
         ( d
             (while (= 5 (car (setq ept (grread t 13 0))))
                 (redraw)
                 (foreach obj obl (vla-delete obj))
                 (setq qty (/ (caddr (trans (mapcar '- (cadr ept) bpt) 1 vxw t)) dis)
                       obl (incarray:copyvector lst (mapcar (if (minusp qty) '- '+) vxw) (abs (fix qty)) inc)
                 )
                 (grvecs (list -3 bpt (mapcar '(lambda ( a b ) (+ (* a qty) b)) vxu bpt)))
             )
         )
         (   (setq ept (cadr(grread 3)))
             (setq qty (fix (/ (caddr (trans (mapcar '- ept bpt) 1 vxw t)) dis)))
             (incarray:copyvector lst (mapcar (if (minusp qty) '- '+) vxw) (abs (fix qty)) inc)
         )
     )
     (setvar 'dimzin dim)
     (incarray:endundo (incarray:acdoc))
     (redraw) (princ)
)
;;----------------------------------------------------------------------
(defun incarray:num->str ( x / dim rtn )
     (if (equal x (atof (rtos x 2 0)) 1e-8)
         (rtos x 2 0)
         (progn
             (setq dim (getvar 'dimzin))
             (setvar 'dimzin 8)
             (setq rtn (vl-catch-all-apply 'rtos (list x 2 15)))
             (setvar 'dimzin dim)
             (if (not (vl-catch-all-error-p rtn)) rtn)
         )
     )
)
;;----------------------------------------------------------------------
(defun incarray:copyvector (lst vec qty inc / cnt obj obl org)
     (setq org (vlax-3D-point 0 0) cnt 1)
     (repeat qty
         (foreach itm lst
             (setq obj (vla-copy (car itm))
                   obl (cons obj obl)
             )
             (vla-move obj org (vlax-3D-point (mapcar '* vec (list cnt cnt cnt))))
             (if (= "AcDbBlockReference" (vla-get-objectname obj))
                 (mapcar
                     (function
                         (lambda ( att prp )
                             (vl-catch-all-apply 'vlax-put-property
                                 (list att (car prp)
                                     (apply 'strcat
                                         (mapcar '(lambda ( x ) (incarray:increment x (* cnt inc)))
                                             (cdr prp)
                                         )
                                     )
                                 )
                             )
                         )
                     )
                     (vlax-invoke obj 'getattributes)
                     (cdr itm)
                 )
                 (foreach prp (cdr itm)
                     (vlax-put-property obj (car prp)
                         (apply 'strcat
                             (mapcar '(lambda ( x ) (incarray:increment x (* cnt inc)))
                                 (cdr prp)
                             )
                         )
                     )
                 )
             )
         )
         (setq cnt (1+ cnt))
     )
     obl
)
;;----------------------------------------------------------------------
(defun incarray:selection->list (sel / idx lst obj obn)
     (if sel
         (repeat (setq idx (sslength sel))
             (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))
                   obn (vla-get-objectname obj)
             )
             (if (and (= "AcDbBlockReference" obn) (= :vlax-true (vla-get-hasattributes obj)))
                 (setq lst
                     (cons
                         (cons obj
                             (mapcar '(lambda ( a ) (vl-list* 'textstring (incarray:splitstring (vla-get-textstring a))))
                                 (vlax-invoke obj 'getattributes)
                             )
                         )
                         lst
                     )
                 )
                 (setq lst
                     (cons
                         (cons obj
                             (mapcar '(lambda ( p ) (vl-list* p (incarray:splitstring (vlax-get-property obj p))))
                                 (cond
                                     (   (wcmatch obn "AcDb*Text,AcDbMLeader") '(textstring))
                                     (   (wcmatch obn "AcDb*Dimension")        '(textoverride))
                                     (   (= "AcDbAttributeDefinition" obn)     '(tagstring promptstring textstring))
                                 )
                             )
                         )
                         lst
                     )
                 )
             )
         )
     )
)
;;----------------------------------------------------------------------;;
(defun incarray:splitstring (str / lst)
     (setq lst (vl-string->list str))
     (read (vl-list->string (vl-list* 40 34 (incarray:split lst (< 47 (car lst) 58)))))
)
;;----------------------------------------------------------------------;;
(defun incarray:split (lst flg)
     (cond
         ((null lst) '(34 41))
         ((= 92 (car lst))
             (if flg
                 (vl-list* 34 32 34 92 92 (incarray:split (cdr lst) nil))
                 (vl-list* 92 92 (incarray:split (cdr lst) flg))
             )
         )
         ((or (< 47 (car lst) 58) (and (= 46 (car lst)) flg (< 47 (cadr lst) 58)))
             (if flg
                 (vl-list* (car lst) (incarray:split (cdr lst) flg))
                 (vl-list* 34 32 34 (car lst) (incarray:split (cdr lst) t))
             )
         )
         (flg (vl-list* 34 32 34 (car lst) (incarray:split (cdr lst) nil)))
         ((vl-list* (car lst) (incarray:split (cdr lst) nil)))
     )
)
;;----------------------------------------------------------------------
(defun incarray:increment (str inc / dci dcs len num)
     (if (numberp (read str))
         (progn
             (setq num (+ (distof str) inc)
                   inc (incarray:num->str inc)
                   str (vl-string-left-trim "-" str)
                   inc (vl-string-left-trim "-" inc)
                   dci (incarray:decimalplaces inc)
                   dcs (incarray:decimalplaces str)
                   len (strlen str)
                   str (vl-string-left-trim "-" (rtos num 2 (max dci dcs)))
             )
             (cond
                 ((< 0 dcs) (setq len (+ (- len dcs) (max dci dcs))))
                 ((< 0 dci) (setq len (+ dci len 1)))
             )
             (repeat (- len (strlen str))
                 (setq str (strcat "0" str))
             )
             (if (minusp num)
                 (strcat "-" str)
                 str
             )
         )
         str
     )
)
;;----------------------------------------------------------------------
(defun incarray:decimalplaces (str / pos)
     (if (setq pos (vl-string-position 46 str))
         (- (strlen str) pos 1)
         0
     )
)
;;----------------------------------------------------------------------
(defun incarray:startundo(doc)
     (incarray:endundo doc)
     (vla-startundomark doc)
)
;;----------------------------------------------------------------------
(defun incarray:endundo(doc)
     (while (= 8 (logand 8 (getvar 'undoctl)))
         (vla-endundomark doc)
     )
)
;;----------------------------------------------------------------------
(defun incarray:acdoc nil
     (eval (list 'defun 'incarray:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
     (incarray:acdoc)
)
(princ)

xtjd

(defun c:d2(/ ss p1 p2 x_x i)
;*d2_i* 全局变量，记录增量值
(defun x_x(ss i)
  (if(setq p1(getpoint(strcat "\n 指定复制基点：（左键 + 右键 -）")))
   (if(setq p2(getpoint p1(strcat "\n 指定阵列间距：")))(LM:incarray t ss i p1 p2))
   (if(setq p1(getpoint(strcat "\n 指定复制基点：（递减）")) p2(getpoint p1 (strcat "\n 指定阵列间距：")))
    (LM:incarray t ss (* -1 i) p1 p2)
   )
  )
)
(or *d2_i*(setq *d2_i* 1))
(if(or(setq ss (ssget"i"))(setq ss (ssget)))
  (progn
   (or(setq i(getint(strcat "\n请输入增量值<" (itoa *d2_i*)">：")))(setq i *d2_i*))
   (x_x ss i)
   (setq *d2_i* i)
  )
)
(vl-cmdf "undo" "be")
(princ)
)

注册

xtjd 发表于 2022-10-19 09:25
(defun c:d2(/ ss p1 p2 x_x i)
;*d2_i* 全局变量，记录增量值
(defun x_x(ss i)

谢谢出手-------------

注册

xtjd 发表于 2022-10-19 09:25
(defun c:d2(/ ss p1 p2 x_x i)
;*d2_i* 全局变量，记录增量值
(defun x_x(ss i)

再请教一下，现在增量值必须是整数值，可以是带小数的值吗，比如2.9

xtjd

注册 发表于 2022-10-19 09:49
再请教一下，现在增量值必须是整数值，可以是带小数的值吗，比如2.9

(defun c:d3(/ ss p1 p2 x_x i)
;*d3_i* 全局变量，记录增量值
(defun x_x(ss i)
  (if(setq p1(getpoint(strcat "\n 指定复制基点：（左键 + 右键 -）")))
   (if(setq p2(getpoint p1(strcat "\n 指定阵列间距：")))(LM:incarray t ss i p1 p2))
   (if(setq p1(getpoint(strcat "\n 指定复制基点：（递减）")) p2(getpoint p1 (strcat "\n 指定阵列间距：")))
    (LM:incarray t ss (* -1 i) p1 p2)
   )
  )
)
(or *d3_i*(setq *d3_i* 1))
(if(or(setq ss (ssget"i"))(setq ss (ssget)))
  (progn
   (or(setq i(getreal(strcat "\n请输入增量值<" (rtos *d3_i*)">：")))(setq i *d3_i*))
   (x_x ss i)
   (setq *d3_i* i)
  )
)
(vl-cmdf "undo" "be")
(princ)
)

注册

xtjd 发表于 2022-10-19 10:35
(defun c:d3(/ ss p1 p2 x_x i)
;*d3_i* 全局变量，记录增量值
(defun x_x(ss i)

可以了，谢谢啊