[讨论]：关于矩阵在ACAD二次开发中的应用的讨论...

XDSoft · 发表于 2002-12-17 01:33:02

最初由 aeo 发布
[B];你试一下:都用你的api
;先画一个曲度很大的弧curve
(setq curve (car (entsel)))
(setq len(cadr (xdrx_getarea curve)) ) ;长度
(setq p1(car(xdrx_curve_GetPoint curve))) ;弧起点
(setq p2(xdrx_curve_get... [/B]

你这样求终点肯定有误差，对距离小于总长的肯定没有问题。

因为你的距离是自己除完等分然后再乘回来（其中就有误差了）。

XDRX_API提供了所有的ARX的关于CURVE类的处理方法，具体问题用具体的方法或者组合。

比如你求终点，就可以用：xdrx_Curve_GetPoint 这个是准确的终点

aeo · 发表于 2002-12-17 01:56:26

不管了,最后点如果不在就硬加进去!
又有问题了:
用了一下(xdrx_PickSet_redraw ss)
求出ss后单独用可以,放到程序里就不行了(程序里求的ss都能进行command操作,肯定对的)
出错见图:

XDSoft · 发表于 2002-12-17 03:10:35

最初由 aeo 发布
[B]不管了,最后点如果不在就硬加进去!
又有问题了:
用了一下(xdrx_PickSet_redraw ss)
求出ss后单独用可以,放到程序里就不行了(程序里求的ss都能进行command操作,肯定对的)
出错见图: [/B]

1、你别用其他的API，就单独测试一个SS，在程序里面看是否还有问题？

2、你下载了最新的XDRX_API了吗？10月24日更新

3、如果还有问题，把你的LISP程序用附件传到论坛

<table border="1" cellpadding="0" cellspacing="0" style="border-collapse: collapse" bordercolor="#111111" width="650" id="AutoNumber1" height="498">
<tr>
<td width="100%" height="489">
<iframe name="I1" width="100%" height="100%" src="http://www.xdcad.net/down/show.php?id=237">
浏览器不支持嵌入式框架或配置为不显示嵌入式框架
</iframe>
</td>
</tr>
</table>

复制代码

aeo · 发表于 2002-12-17 22:21:01

晓东:
(xdrx_PickSet_redraw ss)还是不行,帮看看.
程序很好的执行了,不过把xdrx_PickSet_redraw 给注释掉了,你把注释去掉试试.

程序是把物体随一曲线等分或等距array,用你的xarray总觉的不是那么回事,所以重写了.
小用了一下api里的矩阵转换,弄清楚花了不少时间,蛮好用的.

欢迎大家用和改进!

(defun c:xa (/ $get_point1 getpd _dist array-it _len box curve how num p0 ss
ss1 yes-mi yes-ro
)
(defun $get_point1 (e n dist / j pt ptl)
(setq j 1)
(while (< j n)
(setq pt (xdrx_curve_getpointatdist e (* j dist)))
(if pt
(setq ptl (cons pt ptl))
)
(setq j (1+ j))
)
(reverse ptl)
)
; ************************
(defun getpd (/ no s-pd)
(if (not #xarray_dist)
(setq #xarray_dist 100)
)
(setq s-pd (getstring (strcat "\nNumber to divide$add X$or Distance("
(rtos #xarray_dist 2 2) "):"
)
)
)
(cond
((setq no (xdrx_txtsrch s-pd "x"))
(setq s-pd (substr s-pd 1 (1- (car no))))
(setq s-pd (atoi s-pd))
(setq s-pd (cons 0 s-pd))
)
(t
(if (= s-pd "")
(setq s-pd #xarray_dist)
(setq s-pd (atof s-pd))
)
(setq s-pd (cons 1 s-pd))
)
)
)
; ***************************to array
(defun array-it (p0 ss yes-ro yes-mi num _dist how / angl p1 p2 pntl pntl1
xform xform1 xform2 ss1
)
(setq p1 (car (xdrx_curve_GetPoint curve)))
(setq p2 (caddr (xdrx_curve_GetPoint curve)))
(setq pntl ($get_point1 curve num _dist) ; mid point
pntl (cons p1 pntl) ; first point
)
(if (= how 0)
(setq pntl (reverse (cons p2 (reverse pntl)))) ; last point
)
(if (= yes-ro "Yes")
(setq angl (mapcar
'(lambda (x)
(cadr (xdrx_getperpline curve x))
)
pntl
)
)
)
(if yes-mi
(setq angl nil
angl (mapcar
'(lambda (x)
(- (cadr (xdrx_getperpline curve x)) pi)
)
pntl
)
)
)
(setq pntl1 (mapcar
'(lambda (x)
(mapcar
'-
x
p0
)
)
pntl
)
)
(setq xForm (xdrx_matrix_identity 3)
xForm1 (mapcar
'(lambda (x)
(xdrx_matrix_setTransLation xForm x)
)
pntl1
)
)
(if (= yes-ro "Yes")
(progn
(setq xform2 (mapcar
'(lambda (x y)
(xdrx_matrix_setRotation xform x '(0 0 1) y)
)
angl
pntl
)
)
(setq xform1 (mapcar
'(lambda (x y)
(xdrx_matrix_product x y)
)
xform2
xform1
)
)
)
)
(c:xdrx_setmark)
(mapcar
'(lambda (x)
(xdrx_entity_transformedcopy ss x)
)
xForm1
)
(setq ss1 (c:xdrx_getss))
)
; ***************************************main
(prompt "\nthe object to xarray")
(setq ss (ssget))
(if ss
(progn
(setq p0 (getpoint "base-point$return for middle point$:"))
(if (not p0)
(setq box (xdrx_entity_box ss)
p0 (xdrx_midp (car box) (caddr box))
)
)
(setq curve (car (xdrx_entsel "\npickSel a curve<esc>:" '((0 . "*line,arc,circle,ellipse")))))
)
)
(if (and
ss
curve
)
(progn
(xdrx_begin)
(xdrx_ucson)
(princ (strcat "\nLength of Curve:" (rtos (setq _len (cadr
(xdrx_getarea curve)
)
)
2 2
)
)
)
(setq _dist (getpd))
(setq how (car _dist)
_dist (cdr _dist)
)
(if (= how 0)
(setq num _dist
_dist (/ _len _dist)
)
(setq num(1+ (fix (/ _len _dist))))
)
(setq #xarray_dist _dist)
(initget "Yes No")
(setq yes-ro (getkword "\nRotate it while?<(Yes)or No>"))
(if (not yes-ro)
(setq yes-ro "Yes")
)
(setq ss1 (array-it p0 ss yes-ro nil num _dist how))
; (xdrx_PickSet_redraw ss1)
(if (= yes-ro "Yes")
(progn
(initget "Yes No")
(setq yes-mi (getkword "\nMirror all<Yes or (No)>?"))
(if (not yes-mi)
(setq yes-mi "No")
)
(if (= "Yes" yes-mi)
(progn
(command "erase" ss1 "")
(array-it p0 ss yes-ro t num _dist how)
)
; (xdrx_PickSet_redraw ss1 t)
)
)
)
(xdrx_ucsoff)
(xdrx_end)
)
)
(princ)
)

(defun c:xa (/ $get_point1 getpd _dist array-it _len box curve how num p0 ss 
               ss1 yes-mi yes-ro 
            ) 
  (defun $get_point1 (e n dist / j pt ptl) 
    (setq j 1) 
    (while (< j n) 
      (setq pt (xdrx_curve_getpointatdist e (* j dist))) 
      (if pt 
        (setq ptl (cons pt ptl)) 
      ) 
      (setq j (1+ j)) 
    ) 
    (reverse ptl) 
  )                                        
; ************************ 
  (defun getpd (/ no s-pd) 
    (if (not #xarray_dist) 
      (setq #xarray_dist 100) 
    ) 
    (setq s-pd (getstring (strcat "\nNumber to divide$add X$or Distance(" 
                                  (rtos #xarray_dist 2 2) "):" 
                          ) 
               ) 
    ) 
    (cond 
      ((setq no (xdrx_txtsrch s-pd "x")) 
        (setq s-pd (substr s-pd 1 (1- (car no)))) 
        (setq s-pd (atoi s-pd)) 
        (setq s-pd (cons 0 s-pd)) 
      ) 
      (t 
        (if (= s-pd "") 
          (setq s-pd #xarray_dist) 
          (setq s-pd (atof s-pd)) 
        ) 
        (setq s-pd (cons 1 s-pd)) 
      ) 
    ) 
  )                                        
; ***************************to array 
  (defun array-it (p0 ss yes-ro yes-mi num _dist how / angl p1 p2 pntl pntl1 
                      xform xform1 xform2 ss1 
                  ) 
    (setq p1 (car (xdrx_curve_GetPoint curve))) 
    (setq p2 (caddr (xdrx_curve_GetPoint curve))) 
    (setq pntl ($get_point1 curve num _dist)         ; mid point 
          pntl (cons p1 pntl)                        ; first point 
    )                                        
    (if (= how 0) 
      (setq pntl (reverse (cons p2 (reverse pntl)))) ; last point 
    )                                      
    (if (= yes-ro "Yes") 
      (setq angl (mapcar 
                   '(lambda (x) 
                      (cadr (xdrx_getperpline curve x)) 
                    ) 
                   pntl 
                 ) 
      ) 
    ) 
    (if yes-mi 
      (setq angl nil 
            angl (mapcar 
                   '(lambda (x) 
                      (- (cadr (xdrx_getperpline curve x)) pi) 
                    ) 
                   pntl 
                 ) 
      ) 
    ) 
    (setq pntl1 (mapcar 
                  '(lambda (x) 
                     (mapcar 
                       '- 
                       x 
                       p0 
                     ) 
                   ) 
                  pntl 
                ) 
    ) 
    (setq xForm (xdrx_matrix_identity 3) 
          xForm1 (mapcar 
                   '(lambda (x) 
                      (xdrx_matrix_setTransLation xForm x) 
                    ) 
                   pntl1 
                 ) 
    ) 
    (if (= yes-ro "Yes") 
      (progn 
        (setq xform2 (mapcar 
                       '(lambda (x y) 
                          (xdrx_matrix_setRotation xform x '(0 0 1) y) 
                        ) 
                       angl 
                       pntl 
                     ) 
        ) 
        (setq xform1 (mapcar 
                       '(lambda (x y) 
                          (xdrx_matrix_product x y) 
                        ) 
                       xform2 
                       xform1 
                     ) 
        ) 
      ) 
    ) 
    (c:xdrx_setmark) 
    (mapcar 
      '(lambda (x) 
         (xdrx_entity_transformedcopy ss x) 
       ) 
      xForm1 
    ) 
    (setq ss1 (c:xdrx_getss)) 
  )                                        
; ***************************************main 
  (prompt "\nthe object to xarray") 
  (setq ss (ssget)) 
  (if ss 
    (progn 
      (setq p0 (getpoint "base-point$return for middle point$:")) 
      (if (not p0) 
        (setq box (xdrx_entity_box ss) 
              p0 (xdrx_midp (car box) (caddr box)) 
        ) 
      ) 
      (setq curve (car (xdrx_entsel "\npickSel a curve<esc>:" '((0 . "*line,arc,circle,ellipse"))))) 
    ) 
  ) 
  (if (and 
        ss 
        curve 
      ) 
    (progn 
      (xdrx_begin) 
      (xdrx_ucson) 
      (princ (strcat "\nLength of Curve:" (rtos (setq _len (cadr 
                                                                 (xdrx_getarea curve) 
                                                           ) 
                                                ) 
                                                2 2 
                                          ) 
             ) 
      ) 
      (setq _dist (getpd)) 
      (setq how (car _dist) 
            _dist (cdr _dist) 
      ) 
      (if (= how 0) 
        (setq num _dist 
              _dist (/ _len _dist) 
        ) 
        (setq num(1+ (fix (/ _len _dist)))) 
      ) 
      (setq #xarray_dist _dist) 
      (initget "Yes No") 
      (setq yes-ro (getkword "\nRotate it while?<(Yes)or No>")) 
      (if (not yes-ro) 
        (setq yes-ro "Yes") 
      ) 
      (setq ss1 (array-it p0 ss yes-ro nil num _dist how)) 
       ; (xdrx_PickSet_redraw ss1) 
      (if (= yes-ro "Yes") 
        (progn 
          (initget "Yes No") 
          (setq yes-mi (getkword "\nMirror all<Yes or (No)>?")) 
          (if (not yes-mi) 
            (setq yes-mi "No") 
          ) 
          (if (= "Yes" yes-mi) 
            (progn 
              (command "erase" ss1 "") 
              (array-it p0 ss yes-ro t num _dist how) 
            )                                
       ; (xdrx_PickSet_redraw ss1 t) 
          ) 
        ) 
      ) 
      (xdrx_ucsoff) 
      (xdrx_end) 
    ) 
  ) 
  (princ) 
)

账号		自动登录	找回密码
密码			立即注册