阵列代码的一点小问题

陈同学

小白一枚，请大神帮忙看看怎么修改能够使下面代码可以在用户坐标系中使用，现在只能在世界坐标系中成功

• ;;; ***********直线阵列******************************======================;
• (defun c:sar( / dir gr nx p0 px pxv ss ss1 vecx)
•   (vl-load-com)
•   (setq  ss (std-sslist (ssget))
•         p0 (getpoint "\nP0:")
•         px (getpoint p0 "\nPx:")
•         ;vecx (mapcar '- px p0)
•     vecx (list(-(car px) (car p0)) 0 0)
•   )
•   (prompt "\nThe end point:")
•   (while (= (car (setq gr (grread nil 5 0))) 5)
•     (if  ss1 (q:ss:del ss1))
•     (redraw)
•     (setq pxv (mapcar '- (inters (cadr gr) (polar (cadr gr) (+ (/ pi 2.0) (angle px p0)) 1.0) p0 px nil) p0))
•     ;(setq  pxv (list(car pxv)0 0))
•     (if (< (setq nx  (fix (/ (caddr (trans pxv 0 vecx)) (caddr (trans vecx 0 vecx)))) ) 0)
•            (setq dir -1 nx (- nx)) (setq dir 1))
•     (setq ss1 (q:ss:dyngen ss nx vecx dir))
•     (grdraw p0 (mapcar '+ p0 pxv) 3 1)
•   )
• (redraw)
•   (princ)
• )
• ;;; ===============================================================;
• (defun q:ss:dyngen (sslst n v dir / i matlist obj1 ss transmat xobj)
•   (setq ss (ssadd))
•   (foreach x sslst
•     (setq xobj (vlax-ename->vla-object x) i 1)
•     (repeat n
•       (setq obj1 (vla-copy xobj)
•             matList (list (list 1 0 0 (* i (car v) dir)) (list 0 1 0 (* i (cadr v) dir)) '(0 0 1 0) '(0 0 0 1))
•             transmat (vlax-tmatrix matlist))
•       (vla-transformby obj1 transMat)
•       (ssadd (vlax-vla-object->ename obj1) ss)
•       (setq i (1+ i))
•     )
•   )
•   ss
• )
• ;;; =======================================================================;
• (defun q:ss:del  (ss / i)
•   (setq i 0)
•   (repeat (sslength ss)
•     (entdel (ssname ss i))
•     (setq i (1+ i))
•   )
• )
• ;;; =======================================================================;
• (defun q:ss:add  (ss1 ss2 / i)
•   (setq i -1)
•   (repeat (sslength ss2)
•     (setq i (1+ i))
•     (setq ss1 (ssadd (ssname ss2 i) ss1))
•   )
•   ss1
• )
• ;;; =======================================================================;
• (defun std-sslist  (ss / n lst)
•   (if  (eq 'pickset (type ss))
•     (repeat (setq n (fix (sslength ss))) ; fixed
•       (setq lst (cons (ssname ss (setq n (1- n))) lst))
•     )
•   )
• )
  

caoyin

;;修改了两个地方
(defun c:sar( / dir gr nx p0 px pxv ss ss1 vecx)
  (vl-load-com)
  (setq  ss (std-sslist (ssget))
        p0 (getpoint "\nP0:")
        px (getpoint p0 "\nPx:")
         vecx (mapcar '- px p0)
  )
  (prompt "\nThe end point:")
  (while (= (car (setq gr (grread nil 5 0))) 5)
    (if  ss1 (q:ss:del ss1))
    (redraw)
    (setq pxv (mapcar '- (inters (cadr gr) (polar (cadr gr) (+ (/ pi 2.0) (angle px p0)) 1.0) p0 px nil) p0))
    ;(setq  pxv (list(car pxv)0 0))
    (if (< (setq nx  (fix (/ (caddr (trans pxv 0 vecx)) (caddr (trans vecx 0 vecx)))) ) 0)
           (setq dir -1 nx (- nx)) (setq dir 1))
    (setq ss1 (q:ss:dyngen ss nx (trans vecx 1 0 T) dir))
    (grdraw p0 (mapcar '+ p0 pxv) 3 1)
  )
(redraw)
  (princ)
)

陈同学

caoyin 发表于 2021-1-20 23:18
;;修改了两个地方
(defun c:sar( / dir gr nx p0 px pxv ss ss1 vecx)
  (vl-load-com)

多谢