Need Domineco's help on axial rotate routine...

Discussion in 'AutoCAD' started by Devin, Jul 23, 2003.

1. DevinGuest

Hi there,

I'm getting an error when supplying the following argumtents in order to the
axial rotate function...

y2: (-10.9759 50.9986 -1.22461e-016)
xang: 5.49779
mpt: (-10.2981 50.2633 -6.12303e-017)
xvector: (-10.2981 50.2633 0.0)

Thanks for any help,

Devin

Here's the code...

(defun :VECTOR_2P (pt1 pt2 / )
(if(equal pt1 pt2 1e-10)
nil
(mapcar (function(lambda (i j) (- j i))) pt1 pt2)
)
)

(defun :ACOS (x)
;
(cond
((equal x -1.0 1e-06) (setq x -1.0) )
((equal x 1.0 1e-06) (setq x 1.0) )
((> x 1.0) (setq x nil ) )
((< x -1.0) (setq x nil ) )
)
(if x
(atan (sqrt (- 1.0 (expt x 2.0))) x)
nil
)
)

(defun :VECTOR_SCALAR_PRODUCT (v1 v2)
v2)) )
)

(defun :VECTOR_MODULE (v / X Y Z)
(if (not z) (setq z 0.0))
(sqrt (+ (* z z) (* x x) (* y y) ) )
)

; returns intenal angle (radiants) for 3 3d points
(defun 3dangle (p1 px p3 / V1 V3)
(setq v1 VECTOR_2P px p1))
(if v1
(setq v3 VECTOR_2P px p3))
)
(if v3
(if (not (equal v1 v3 1e-12)) ACOS
(/ VECTOR_SCALAR_PRODUCT v1 v3)
(* VECTOR_MODULE v1) VECTOR_MODULE v3) )
)
)
0.0
)
nil
)
)

(defun :SQR (n)
(if (> n 46340)
(* (float n) n)
(* n n)
)
)

(defun axial_rotate ( px angx p1 p2
/
N P PZ SINA SINB SINC
)
(setq *EPS10* 1.0e-010)

(setq n VECTOR_2P p1 p2)
lenxy (sqrt (+ SQR (car n)) SQR (cadr n))))
)
(if (> lenxy *EPS10*)
(setq cosa (/ (car n) lenxy) sina (/ (cadr n) lenxy) )
(setq cosa 1.0 sina 0.0 )
)
(setq len VECTOR_MODULE n)
sinb (/ lenxy len)
cosc (cos angx)
sinc (sin angx)
p VECTOR_2P p1 px)
carp (car p)
px (+ (* cosa carp) (* sina cadrp))
carp px
pz (+ (* cosb caddrp)(* sinb carp) )
carp (+(* -1.0 sinb caddrp)(* cosb carp))
px (-(* cosc carp) (* sinc cadrp))
carp px
pz (-(* cosb caddrp)(* sinb carp))
carp (+(* sinb caddrp)(* cosb carp))
px (-(* cosa carp)(* sina cadrp))
carp px
)
(list
(+ carp (car p1))
)

)

Devin, Jul 23, 2003

2. Domenico Maria PisanoGuest

I tested it and it seems to work well .
Send me the the code that you use to test it and
do not change (now) no functions or variables names.

:ANG2D_3P3D_I requires 3 3d points :
the first point, the middle point and the third point.

What is "xvector" ?

Why has "y2" the zeta coordinate so small (-1.22461e-016) ?
Why has "mpt" the zeta coordinate so small (-6.12303e-017) ?

Use this to test it :

(defun C:TA3PI ()
(setq px (getpoint "\nmiddle point:"))
(setq p1 (getpoint px "\nfirst point:"))
(setq p3 (getpoint px "\nthird point:"))
(alert(rtos RG ANG2D_3P3D_I p1 px p3)) 2 2))
)

(defun :RG (a / R)
(setq r (/ (* a 180.0) pi))
(if (equal r 360.0) (setq r 0.0))
r
)

----- Original Message -----
From: "Devin" <>
Sent: Wednesday, July 23, 2003 2:34 AM
Subject: Need Domineco's help on axial rotate routine...

Domenico Maria Pisano, Jul 23, 2003

3. DevinGuest

I'm using this as a midpoint function. Is it accurate?

(defun midpoint ( p1 p2 / )
(cond
(
(and
(= (length p1) 3)
(= (length p2) 3)
)
(list
(/ (+ (car p1) (car p2)) 2.0)
)
)
(
(or
(= (length p1) 2)
(= (length p2) 2)
)
(list
(/ (+ (car p1) (car p2)) 2.0)
(/ (+ (cadr p1) (cdar p2)) 2.0)
)
)
)
)

Thanks,

Devin

Devin, Jul 23, 2003
4. DevinGuest

I figured out that my code is small in this case so here it is...

(defun 3pxa_ucs ( origin xvector yvector xang / ucs -yvector mpt newyector )
(setq
-yvector (axial_rotate yvector 180d origin xvector)
mpt (midpoint yvector -yvector)
newyvector (axial_rotate -yector xang mpt xvector)
)
(if
(tblsearch "UCS" "PDATA_BLOCK")
(vla-delete (vla-item ucss "PDATA_BLOCK"))
)
(setq ucs (vla-add ucss (vlax-3d-point mpt) (vlax-3d-point xvector)
(vlax-3d-point newyvector) "PDATA_BLOCK"))
(vla-put-origin ucs (vlax-3d-point origin))
(vla-put-activeucs curdoc ucs)
)

Thanks,

Devin

Devin, Jul 23, 2003
5. DevinGuest

Got it...

(defun 3pxa_ucs ( origin xvector yvector xang / -yvector -xvector mpt
newyector )
(setq
-yvector (axial_rotate yvector 180d origin xvector)
-xvector (axial_rotate origin 180d yvector -yvector)
mpt (midpoint yvector -yvector)
newyvector (axial_rotate -yvector xang mpt -xvector)
)
(if
(tblsearch "UCS" "PDATA_BLOCK")
(vla-delete (vla-item ucss "PDATA_BLOCK"))
)
(setq ucs
(vlax-3d-point mpt)
(vlax-3d-point -xvector)
(vlax-3d-point newyvector)
"PDATA_BLOCK"
)
)
(vla-put-origin ucs (vlax-3d-point origin))
(vla-put-activeucs curdoc ucs)
)