Jump to content

Recalculate point coordinates

dilan

By dilan
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

dilan Enthusiast

dilan

Posted
Posted (edited)

In search of an answer to my question, I found a topic: https://www.cadtutor.net/forum/topic/60244-align-command-in-lisp-format/

User 1958 posted the program: 

;;;;   Graphical Helmert's transformation
;;;;   ----------------------------------
(defun C:Helmert ( / lun lup aun aup ang ib1 ib2 x1 y1 X2 Y2
		     q ib xt1 yt1 Xt2 Yt2 t1 t2 dx dy ir Xx Yy xr yr
                     a1 a2 b1 2b c1 c2 sa1 sa2 sb1 sb2 sc1 sc2
                     at bt qt wt wtr wtd scl et)
  (setq lun (getvar "LUNITS"))
  (setq lup (getvar "LUPREC"))
  (setq aun (getvar "AUNITS"))
  (setq aup (getvar "AUPREC"))
  (setq ang (getvar "ANGDIR"))
  (setvar "LUNITS" 2)
  (setvar "LUPREC" 3)
  (setvar "AUNITS" 2)
  (setvar "AUPREC" 4)
  (setvar "ANGDIR" 1)
  (setq ib1 (getpoint "\n Source 1 point : "))
  (setq ib2 (getpoint ib1 "\n 1 Point Targets : "))
  (setq x1 (list (car ib1)))
  (setq y1 (list (cadr ib1)))
  (setq X2 (list (car ib2)))
  (setq Y2 (list (cadr ib2)))
  (grdraw ib1 ib2 5)
  (setq ib1 (getpoint "\n Source 2 point : "))
  (setq ib2 (getpoint ib1 "\n 2 Point Targets : "))
  (setq x1 (append x1 (list (car ib1))))
  (setq y1 (append y1 (list (cadr ib1))))
  (setq X2 (append X2 (list (car ib2))))
  (setq Y2 (append Y2 (list (cadr ib2))))
  (grdraw ib1 ib2 5)
   (setq q "Y"
	ib 2)
  (while (/= q "N")
    (initget "Y N")
    (setq q (getkword "\n The next point? Yes/No <Y> : "))
    (if (or (= q "y") (= q "Y") (= q nil))
      (progn
        (setq ib1 (getpoint "\n Next Source point : "))
        (setq ib2 (getpoint ib1 "\n Next Point Targets : "))
        (setq x1 (append x1 (list (car ib1))))
        (setq y1 (append y1 (list (cadr ib1))))
        (setq X2 (append X2 (list (car ib2))))
        (setq Y2 (append Y2 (list (cadr ib2))))
	(setq ib (+ 1 ib))
        (grdraw ib1 ib2 5)
      )
    )
  )
  (setq xt1 0.0
	yt1 0.0
	Xt2 0.0
	Yt2 0.0)
  (foreach p x1 (setq xt1 (+ xt1 p)))
  (foreach p y1 (setq yt1 (+ yt1 p)))
  (foreach p X2 (setq Xt2 (+ Xt2 p)))
  (foreach p Y2 (setq Yt2 (+ Yt2 p)))
  (setq xt1 (/ xt1 ib))
  (setq yt1 (/ yt1 ib))
  (setq t1 (list xt1 yt1))
  (setq t2 (list (/ Xt2 ib) (/ Yt2 ib)))
  (setq dx (- (nth 0 t2) (nth 0 t1)))
  (setq dy (- (nth 1 t2) (nth 1 t1)))
   (grdraw t1 t2 6)
  (setq ir 0)
  (setq Xx nil
	Yy nil
	xr nil
	yr nil)
  (while (< ir ib)
    (setq Xx (append Xx (list (- (nth ir X2) (nth ir x1)))))
    (setq Yy (append Yy (list (- (nth ir Y2) (nth ir y1)))))
    (setq xr (append xr (list (- (nth ir x1) xt1))))
    (setq yr (append yr (list (- (nth ir y1) yt1))))
    (setq ir (+ 1 ir))
  )
   (setq ir 0)
  (setq a1 nil
	a2 nil
	b1 nil
	b2 nil
	c1 nil
	c2 nil)
  (while (< ir ib)
    (setq a1 (append a1 (list (* (nth ir Xx) (nth ir xr)))))
    (setq a2 (append a2 (list (* (nth ir Yy) (nth ir yr)))))
    (setq b1 (append b1 (list (* (nth ir Yy) (nth ir xr)))))
    (setq b2 (append b2 (list (* (nth ir Xx) (nth ir yr)))))
    (setq c1 (append c1 (list (* (nth ir xr) (nth ir xr)))))
    (setq c2 (append c2 (list (* (nth ir yr) (nth ir yr)))))    
    (setq ir (+ 1 ir))
  )
  (setq ir 0)
  (setq sa1 0.0
	sa2 0.0
	sb1 0.0
	sb2 0.0
	sc1 0.0
	sc2 0.0)
  (while (< ir ib)
    (setq sa1 (+ sa1 (nth ir a1)))
    (setq sa2 (+ sa2 (nth ir a2)))
    (setq sb1 (+ sb1 (nth ir b1)))
    (setq sb2 (+ sb2 (nth ir b2)))
    (setq sc1 (+ sc1 (nth ir c1)))
    (setq sc2 (+ sc2 (nth ir c2)))
    (setq ir (+ 1 ir))    
  )
  (setq at (/ (+ sa1 sa2) (+ sc1 sc2)))
  (setq at (+ 1 at))
  (setq bt (/ (- sb1 sb2) (+ sc1 sc2)))
  (setq qt (sqrt (+ (* at at) (* bt bt))))
  (setq wt (atan bt at))
  (setq wtr (* (1- 0) (/ (* 200.0 wt) pi)))
  (setq wtd (* (1- 0) (/ (* 180.0 wt) pi)))  
  (setq q "Y")
  (initget "Y N")
  (setq q (getkword "\n Apply scaling? Yes/No_(q=1)/User  <Y> : "))
  (if (or (= q "y") (= q "Y") (= q nil))
    (setq scl qt)
  )
  (if (or (= q "n") (= q "N"))
    (setq scl 1.0)
  )
  (if (or (= q "u") (= q "U"))
    (setq scl (getreal "User's scale : "))
  )
  (setq et (ssget))
  (setq q "N")
  (initget "N Y")
  (setq q (getkword "\n Save the original? No/Yes <N> : "))
  (if (or (= q "y") (= q "Y"))
    (command "_copy" et "" "0,0,0" "0,0,0") 
  )
  (command "_move" et "" "_none" t1 "_none" t2)
  (command "_rotate" et "" "_none" t2 wtr)
  (command "_scale" et "" "_none" t2 scl)
  (princ
    (strcat "\n  dY : " (rtos dx 2 3) "    dX : " (rtos dy 2 3)
     "\n  w  : " (rtos wtr 2 4) "g    " (rtos wtd 2 5) "°    q : " (rtos scl 2 8)
    )
  )  
  (setvar "LUNITS" lun)
  (setvar "LUPREC" lup)
  (setvar "AUNITS" aun)
  (setvar "AUPREC" aup)
  (setvar "ANGDIR" ang)

)

This program moves and rotate selected objects according to the example of a standard autocad command align.

But I have a different task, I need to recalculate the coordinates of the point.

Knowing the angle of rotation and offset along the axis X and Y.

 

I tried to do it myself: 

(defun get_baz_line ( / ang )
(setq p1 (getpoint "\nSpecify first point  ->>"))
(setq p2 (getpoint "\nSpecify second point ->>"))
(setq ang (angle p1 p2))
ang
)
(setq ang_1 (get_baz_line)
      XY1_1 p1 ; The first coordinate of the baseline
	  XY2_1 p2 ; The second coordinate of the baseline
	  ang_2 (get_baz_line)
	  XY1_2 p1 ; The first coordinate of the new line
	  XY2_2 p2 ; The second coordinate of the new line
	  Dif_ang (- ang_2 ang_1); ANGLE for recalculating point coordinates
)
(setq delta_X (-             ; Offset by axis X
                 (car XY1_2)
				     (- 
					    (* (car XY1_1) (cos (atof (angtos Dif_ang 3 4))))
						(* (cadr XY1_1)(sin (atof (angtos Dif_ang 3 4))))
						)
						)
						); end of setq
(setq delta_Y (-             ; Offset by axis Y
                 (cadr XY1_2)
				     (+ 
					    (* (car XY1_1)(sin (atof (angtos Dif_ang 3 4))))
						(* (cadr XY1_1)(cos (atof (angtos Dif_ang 3 4))))
						)
						)
						); end of setq

 

And here I am stuck....

I can not understand what's next.

I tried to repeat the formula from exel (watch attachment), but I could not get the correct data.

 

If anyone can help with advice, I will be very grateful.

Thank.

 

pic.jpg

Edited by dilan
hanhphuc Mentor

hanhphuc

Posted
Posted (edited)

 

EXCEL data in 2D try this sub - rectangular to polar coordinates  

(defun r->p (v / a) ; v (x,y)
 ;2D Rectangular -> polar coordinates - hanhphuc 
  (list (if (minusp (setq a (apply 'atan (reverse v))))
          (+ a pi pi)
          a
          )
        (sqrt (apply '+ (mapcar '* v v)))
        )
  ) ; angle & distance


;;;(rtd (car (r->p '(4 -3))))
;;;126.87
;;;(r->p '(1.0 1.0)) ;(0.785398 1.41421)
;;;(angtos (car (r->p '(3 4))) 1 4) ;"53d7'48\"" 


(defun dmstof (d m s / l) ;hanhphuc
  (setq l (list d m s))
  (if (vl-every ''((x) (and (<= 0. x) (< x 60.))) (cdr l))
    ((if (minusp d)
       -
       +
       )
      (angtof
        (apply 'strcat
               (mapcar ''((a b c) (strcat (rtos (abs a) 2 c) b)) l '("d" "'" "\"") '(0 0 2))
               )
        )
      )
    )
  )

;;;(dmstof -176 35 10.3)
;;;-3.08201
;;;(setq str (getstring t "\nDDD MM SS : ") )
;;;(apply 'dmstof (read (strcat "(" str ")")))

 

;example from your EXCEL sheet
(setq ; a ( angltof  '(-176 35 10.3) )          

      a (dmstof -176 35 10.3) ;rotation ddd mm ss 
      p  ' ( 172.756 99.97) ; axis offset XY
      op  ' (118.203 43.008) ; point#4= old coordinates XY
      ) 

 

;usage:  

(defun foo (p a op)
(apply 'polar (cons p (mapcar '+ (list a 0.0) (r->p op))
                    )
       )
  )

(foo p a op)

(57.3237 49.9997) ;point#4= new coordinates XY
 

Edited by hanhphuc
typo (r->p x) , dmstof
  • Like 1
dilan Enthusiast

dilan

Posted
  • Author
Posted (edited)
4 hours ago, hanhphuc said:

 

EXCEL data in 2D try this sub - rectangular to polar coordinates  


(defun r->p (v / a) ; v (x,y)
 ;2D Rectangular -> polar coordinates - hanhphuc 
  (list (if (minusp (setq a (apply 'atan (reverse v))))
          (+ a pi pi)
          a
          )
        (sqrt (apply '+ (mapcar '* v v)))
        )
  ) ; angle & distance

;;;(r->p '(1.0 1.0)) ;(0.785398 1.41421)
;;;(angtos (car (r->p '(3 4))) 1 4) ;"53d7'48\"" 

(defun angltof (l) ;hanhphuc 
  (if (vl-every ''((x) (and (<= 0. x) (< x 60.))) (cdr l))
    ((if (minusp (car l))
       -
       +
       )
      (angtof
        (apply 'strcat
               (mapcar ''((a b c) (strcat (rtos (abs a) 2 c) b)) l '("d" "'" "\"") '(0 0 2))
               )
        )
      )
    )
  )

;;;(angltof '(-176 35 10.3))
;;;-3.08201
;;;(rtd (car (r->p '(4 -3))))
;;;126.87

 

;example from your EXCEL sheet
(setq a ( angltof  '(-176 35 10.3) ) ;rotation ddd mm ss
      p  ' ( 172.756 99.97) ; axis offset XY
      op  ' (118.203 43.008) ; point#4= old coordinates XY
      ) 

 

;usage:  


(defun foo (p a op)
(apply 'polar (cons p (mapcar '+ (list a 0.0) (r->p x))
                    )
       )
  )

(foo p a op)

(57.3237 49.9997) ;point#4= new coordinates XY
 

 

Thanks for the answer.
But I get an error: too few arguments

Found a reason:

(defun foo (p a op)
(apply 'polar (cons p (mapcar '+ (list a 0.0) (r->p op))
                    )
       )
  )

thank you very much for your help, hanhphuc

Edited by dilan
  • Funny 1
hanhphuc Mentor

hanhphuc

Posted
Posted
1 hour ago, dilan said:

 

Thanks for the answer.
But I get an error: too few arguments

Found a reason:

(defun foo (p a op)
(apply 'polar (cons p (mapcar '+ (list a 0.0) (r->p op))
                    )
       )
  )

thank you very much for your help, hanhphuc

you are welcome!

it was typo, glad you got it sorted by yourself :)

 

FYI system variable default should be angdir=0 angbase=0.0

p/s: i slightly optimized (angltof '(ddd mm ss)) to (dmstof ddd mm ss) 

 

  • Like 1
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

If you set a UCS to an angle and a new orign co-ord pick control point and do a co-ord dump is this not what is wanted ? Need to use trans.

 

UCS OB a line at 172.756,99.97 angle 176d35'10"

Edited by BIGAL
hanhphuc Mentor

hanhphuc

Posted
Posted
On 11/6/2019 at 7:49 AM, BIGAL said:

If you set a UCS to an angle and a new orign co-ord pick control point and do a co-ord dump is this not what is wanted ? Need to use trans.

 

UCS OB a line at 172.756,99.97 angle 176d35'10"

 

yes. UCS is the most convenient technic, but for multiple sets of coordinates you can create a block with 0,0 base point.

example like box girder viaduct, we need surveyor setting vertical ducts at each segment for travel form.

hence localize coordinates system at each segment is the easiest way to do setting out. 

The draftman with no coding experience (vlax-curve etc..) can align the blocks to obtain the new coordinates (by rotate/move/measure/divide commands etc..)

then explode or refedit etc..

 

Tendons.thumb.png.6bc2189ef66588fc98a776e8a166aa8c.png

 

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...