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

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

  1. Devin

    Devin Guest

    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)
    bad argument type: numberp: nil

    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)
    (+ (* (car v1)(car v2)) (* (cadr v1)(cadr v2)) (* (caddr v1)(caddr
    v2)) )
    )


    (defun :VECTOR_MODULE (v / X Y Z)
    (setq x (car v) y (cadr v) z (caddr v) )
    (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
    /
    CADDRP CADRP CARP COSA COSB COSC LEN LENXY
    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)
    cosb (/ (caddr n) len)
    sinb (/ lenxy len)
    cosc (cos angx)
    sinc (sin angx)
    p :)VECTOR_2P p1 px)
    carp (car p)
    cadrp (cadr p)
    caddrp (caddr p)
    px (+ (* cosa carp) (* sina cadrp))
    cadrp (+ (* sina -1.0 carp) (* cosa cadrp))
    carp px
    pz (+ (* cosb caddrp)(* sinb carp) )
    carp (+(* -1.0 sinb caddrp)(* cosb carp))
    caddrp pz
    px (-(* cosc carp) (* sinc cadrp))
    cadrp (+(* sinc carp) (* cosc cadrp))
    carp px
    pz (-(* cosb caddrp)(* sinb carp))
    carp (+(* sinb caddrp)(* cosb carp))
    caddrp pz
    px (-(* cosa carp)(* sina cadrp))
    cadrp (+(* sina carp)(* cosa cadrp))
    carp px
    )
    (list
    (+ carp (car p1))
    (+ cadrp (cadr p1))
    (+ caddrp (caddr p1))
    )

    )
     
    Devin, Jul 23, 2003
    #1
    1. Advertisements

  2. 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" <>
    Newsgroups: autodesk.autocad.customization
    Sent: Wednesday, July 23, 2003 2:34 AM
    Subject: Need Domineco's help on axial rotate routine...
     
    Domenico Maria Pisano, Jul 23, 2003
    #2
    1. Advertisements

  3. Devin

    Devin Guest

    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)
    (/ (+ (cadr p1) (cadr p2)) 2.0)
    (/ (+ (caddr p1) (caddr 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
    #3
  4. Devin

    Devin Guest

    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
    #4
  5. Devin

    Devin Guest

    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
    (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 again for your help,

    Devin
     
    Devin, Jul 23, 2003
    #5
    1. Advertisements

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.