Topic: Bearing Orientation and distanse to *.txt

[Kerry]

Have a play with something like this perhaps :

Code - Auto/Visual Lisp: [Select]

1. (defun c:bearing2txt (/ *error* fname  vp vps ep eps p3 s3 fn incl_ang)
2.   (vl-load-com)
3.   (defun *error* (msg)
4.     (if (= 'file (type fn))
5.       (close fn)
6.     )
7.     (if (null (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
8.       (princ (strcat "\nError: " msg))
9.     )
10.     (princ)
11.   )
12.   ;;------------------------------
13.   (setq fname (getfiled "Save Text File As:" "" "txt" 1))
14.   (setq vp  (getpoint "\nPick Base Vertex point: ")
15.         vps (getstring "\nEnter Label Base Reference point: ")
16.         ep  (getpoint vp "\nPick Base Second point: ")
17.         eps (getstring "\nEnter Label of Second point: ")
18.   )
19.   (while (and (setq p3 (getpoint vp (strcat "\nPick Bearing point :")))
20.               (setq s3 (getstring "\nEnter Label of point: "))
21.          )
22.     (if (> (car vp) (car ep))
23.       (cal "incl_ANG=ANG(VP,P3,EP)")
24.       (cal "incl_ANG=ANG(VP,EP,P3)")
25.     )
26.     (setq fn (open fname "a"))
27.     (write-line (strcat vps ": " (vl-princ-to-string vp)) fn)
28.     (write-line (strcat eps ": " (vl-princ-to-string ep)) fn)
29.     (write-line (strcat s3 ": " (vl-princ-to-string p3)) fn)
30.     (write-line (strcat "Distance " vps "->" s3 ": " (rtos (distance vp p3) 2 2)) fn)
31.     (write-line (strcat "Angle "    eps "->" vps "->" s3 ": " (rtos incl_ang 2 6)) fn)
32.     (write-line " ***" fn)
33.     (close fn)
34.   )
35.   (*error* nil)
36.   (princ)
37.  
38. )
39.  
40. (princ)
41.  

vp: (2876.41 2749.1 0.0)
ep: (998.326 2749.1 0.0)
p1: (4098.56 4418.83 0.0)
Distance vp->p1: 2069.22
Angle ep->vp->p1: 126.202130
 ***
vp: (2876.41 2749.1 0.0)
ep: (998.326 2749.1 0.0)
p2: (1919.34 4327.0 0.0)
Distance vp->p2: 1845.47
Angle ep->vp->p2: 58.761219
 ***
vp: (2876.41 2749.1 0.0)
ep: (998.326 2749.1 0.0)
p3: (5303.42 3782.05 0.0)
Distance vp->p3: 2637.68
Angle ep->vp->p3: 156.945096
 ***
vp: (2876.41 2749.1 0.0)
ep: (998.326 2749.1 0.0)
p4: (3746.29 1714.6 0.0)
Distance vp->p4: 1351.62
Angle ep->vp->p4: 229.940411
 ***
vp: (2876.41 2749.1 0.0)
ep: (998.326 2749.1 0.0)
p5: (1351.58 1647.18 0.0)
Distance vp->p5: 1881.31
Angle ep->vp->p5: 324.146384
 ***

[pedroantonio]

Thank you for the try but the code still have the same error. Can not exort txt file

I want to export a file like this

Code: [Select]

1,116.827,12.46
2,138.869,13.55
3,159.3097,14.05
4,182.1792,13.11
and the root stop after the third point !! I want to use it for more like the photo in first post !!

[Kerry]

I'm sure you can modify the code to suit your particular requirements.

I'm not going to do any more on this. It works perfectly for me as you can see from the result data I posted.

If you expect me to write the code for you ;  I'm afraid you don't understand what the swamp is about.

Contact me privately if you want commercial quality code written rather than concept code ... but be prepared to pay commercial rates for the work.

[pedroantonio]

I write this code but I need some help !!

Code - Auto/Visual Lisp: [Select]

1. (defun c:bear2txt (/ p1 p11 p2 p21 p3 p31 d1 fname)
2.   (setq p1 (getpoint "\nPick Base Referene point: "))
3.   (setq p11 (getstring "\nEnter Label Base Referene point: "))
4.   (setq p2 (getpoint p1 "\nPick Second point: "))
5.   (setq p21 (getstring "\nEnter Label of Second point: "))
6.  
7.   (progn
8.     (setq angs (If (> (car p1) (car p2))
9.                  "ang(p1,p3,p2)"
10.                  "ang(p1,p2,p3)"
11.                )
12.     )
13.     (while (setq p3 (getpoint p1 (strcat "\nPick point :")))
14.       (setq p3l (getstring "\nEnter Label of point: "))
15.       (setq d1 (rtos (distance p1 p3) 2 2))
16.       data
17.     )
18.   )
19.  
20.   (princ)
21.   (setvar "cmdecho" 0)
22.   ((write-line
23.      (str fname (getfiled "Save Text File As:" "" "txt" 1) fil)
24.  
25.      (close fil)
26.      (format stream content)
27.    )
28.     (princ)
29.   )
30. )
31.  

I want to export a txt file like this

point number,angle,distance

Thanks

[CAB]

Play with this:

Code - Auto/Visual Lisp: [Select]

1. (defun c:bear2txt (/ p1 p11 p2 p21 p3 p31 d1 fname)
2.   (setq p1 (getpoint "\nPick Base Referene point: "))
3.   (setq p11 (getstring "\nEnter Label Base Referene point: "))
4.   (setq p2 (getpoint p1 "\nPick Second point: "))
5.   (setq p21 (getstring "\nEnter Label of Second point: "))
6.  
7.   (setq angs (if (> (car p1) (car p2))
8.                "ang(p1,p3,p2)"
9.                "ang(p1,p2,p3)"
10.              )
11.   )
12.   (setq data (list p21 p2 p11 p1))
13.  
14.   (while (setq p3 (getpoint p1 (strcat "\nPick point :")))
15.     (setq data (cons p3 data))
16.     (setq p31 (getstring "\nEnter Label of point: "))
17.     (setq data (cons p31 data))
18.     (setq d1 (rtos (distance p1 p3) 2 2))
19.     (setq data (cons d1 data))
20.   )
21.  
22.   (princ)
23.   (setvar "cmdecho" 0)
24.   (setq fname (getfiled "Save Text File As:" "" "txt" 1))
25.   (setq fil (open fname "w"))
26.   (write-line (vl-princ-to-string fname) fil)
27.   (mapcar '(lambda (x) (write-line (vl-princ-to-string x) fil)) (reverse data))
28.   (close fil)
29.   (princ)
30. )

[Kerry]

Pedro,
I'm reminded of this
http://www.theswamp.org/index.php?topic=45804.msg509623#msg509623

perhaps you could show the exact format you want the file to have.

[CAB]

I merged the two threads.

[pedroantonio]

thank you CAB but this lisp gives me coordinate and distance, i need  angle and distance. How i can do it ?

[Kerry]

< .. > this lisp gives me coordinate and distance, i need  angle and distance. How i can do it ?

What have you tried that doesn't work as you want. ?

[mailmaverick]

Try This

Code: [Select]


(defun c:bear2txt (/ p1 p11 p2 p21 p3 p31 d1 fname)
  (setq p1 (getpoint "\nPick Base Referene point: "))
  (setq p11 (getstring "\nEnter Label Base Referene point: "))
  (setq p2 (getpoint p1 "\nPick Second point: "))
  (setq p21 (getstring "\nEnter Label of Second point: "))
  (setq fname (getfiled "Save Text File As:" (getvar 'dwgprefix) "TXT" 1))
  (setq fil (open fname "w"))
  (If (< (car p1) (car p2))
    (progn (setq tmp p1) (setq p1 p2) (setq p2 tmp))
  )
  (setq cnt 1)
  (setq pn p1)
  (while (not (equal pn nil))
    (if (setq pn (getpoint (strcat "\nPick point " (itoa cnt) " : ")))
      (progn (setq pnl (getstring (strcat "\nEnter Label of point " (itoa cnt) " : ")))
     (write-line
       (strcat pnl "," (rtos (distance p1 pn) 2 2) "," (rtos (- (angle p1 p2) (angle p1 pn)) 2 2))
       fil
     )
     (setq cnt (1+ cnt))
      )
    )
  )
  (alert (strcat (itoa (- cnt 1)) " points written in file " fname))
  (close fil)
  (princ)
)


[snownut2]

Almost sounds like you guys are doing someone's homework !

[pedroantonio]

Thank you mailmaverick but the angle is not correct

Code - Auto/Visual Lisp: [Select]

1. (defun c:bear2txt (/ p1 p11 p2 p21 p3 p31 d1 fname)
2.   (setq p1 (getpoint "\nPick Base Referene point: "))
3.   (setq p11 (getstring "\nEnter Label Base Referene point: "))
4.   (setq p2 (getpoint p1 "\nPick Second point: "))
5.   (setq p21 (getstring "\nEnter Label of Second point: "))
6.   (setq fname (getfiled "Save Text File As:" (getvar 'dwgprefix) "TXT" 1))
7.   (setq fil (open fname "w"))
8.   (If (< (car p1) (car p2))
9.     (progn (setq tmp p1) (setq p1 p2) (setq p2 tmp))
10.   )
11.   (setq cnt 1)
12.   (setq pn p1)
13.   (while (not (equal pn nil))
14.     (if (setq pn (getpoint (strcat "\nPick point " (itoa cnt) " : ")))
15.       (progn (setq pnl (getstring (strcat "\nEnter Label of point " (itoa cnt) " : ")))
16.              (write-line
17.                (strcat pnl "," (rtos (- (angle p1 p2) (angle p1 pn)) 2 2) "," (rtos (distance p1 pn) 2 2))
18.                fil
19.              )
20.              (setq cnt (1+ cnt))
21.       )
22.     )
23.   )
24.   (alert (strcat (itoa (- cnt 1)) " points written in file " fname))
25.   (close fil)
26.   (princ)
27. )
28.  

This is the correct angles

Code: [Select]

1,116.827,12.46
2,138.869,13.55
3,159.3097,14.05
4,182.1792,13.11

The angle must be (p2 , p1 , pn ) in grads

The distasne (p1,pn) is correct

The *.dwg file will help you ..

Thanks

[roy_043]

Instead of the (rtos) function, (angtos) should be used for the angle.

[pedroantonio]

Now is working

Code - Auto/Visual Lisp: [Select]

1. (defun c:bear2txt (/ p1 p11 p2 p21 p3 p31 d1 fname)
2.   (setq p1 (getpoint "\nPick Base Referene point: "))
3.   (setq p11 (getstring "\nEnter Label Base Referene point: "))
4.   (setq p2 (getpoint p1 "\nPick Second point: "))
5.   (setq p21 (getstring "\nEnter Label of Second point: "))
6.   (setq fname (getfiled "Save Text File As:" (getvar 'dwgprefix) "TXT" 1))
7.   (setq fil (open fname "w"))
8.   (If (< (car p1) (car p2))
9.     (progn (setq tmp p1) (setq p1 p2) (setq p2 tmp))
10.   )
11.   (setq cnt 1)
12.   (setq pn p1)
13.   (while (not (equal pn nil))
14.     (if (setq pn (getpoint (strcat "\nPick point " (itoa cnt) " : ")))
15.       (progn (setq pnl (getstring (strcat "\nEnter Label of point " (itoa cnt) " : ")))
16.              (write-line
17.                (strcat pnl "," (angtos (+ (angle p2 p1) (angle p1 pn) ) 2 4) "," (rtos (distance p1 pn) 2 2))
18.                fil
19.              )
20.              (setq cnt (1+ cnt))
21.       )
22.     )
23.   )
24.   (alert (strcat (itoa (- cnt 1)) " points written in file " fname))
25.   (close fil)
26.   (princ)
27. )
28.  
29.  

but i have an error with the angle

calculate this angles

Code: [Select]

1,16.8274g,12.46
2,38.8698g,13.55
3,59.3097g,14.05
4,82.1792g,13.11

and the correct are  this

Code: [Select]

1,116.8274g,12.46
2,138.8698g,13.55
3,159.3097g,14.05
4,182.1792g,13.11


[CAB]

Another offering.

Code - Auto/Visual Lisp: [Select]

1. (defun c:bear2txt (/ p1 p1L p2 p2L pn lbl data cnt fil fname)
2.     ;; Get Inside Angle  -  Lee Mac
3.     ;; Returns the smaller angle subtended by three points with vertex at p2
4.     (defun LM:GetInsideAngle ( p1 p2 p3 )
5.        (   (lambda ( a ) (min a (- (+ pi pi) a)))
6.            (rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi))
7.        )
8.     )
9.  
10.  
11.   (setq p1 (getpoint "\nPick Base Referene point: "))
12.   (setq p1L (getstring "\nEnter Label Base Referene point: "))
13.   (setq p2 (getpoint p1 "\nPick Second point: "))
14.   (setq p2L (getstring "\nEnter Label of Second point: "))
15.  (If (< (car p1) (car p2))
16.    (setq tmp p1
17.          p1 p2
18.          p2 tmp
19.          tmp p1L
20.          P1L p2L
21.          p2L tmp)
22.  )
23.  
24.   (setq data (list (strcat "Base point " (vl-princ-to-string p1) "Label " p1L)))
25.   (setq data (cons (strcat "Second point " (vl-princ-to-string p1) "Label " p2L) data))
26.   (setq data (cons "Cnt, Angle, Dist., Label" data))
27.  
28.   (setq cnt 1)
29.   (while (setq pn (getpoint p1 (strcat "\nPick point :")))
30.     (setq lbl (getstring "\nEnter Label of point: "))
31.     (setq data (cons
32.                  (strcat (itoa cnt) ","
33.                          (angtos (LM:GetInsideAngle p2 p1 pn) 2 4) ","
34.                          (rtos (distance p1 pn) 2 2) " "
35.                          lbl)
36.                  data))
37.     (setq cnt (1+ cnt))
38.   )
39.  
40.   (setq fname (getfiled "Save Text File As:" "" "txt" 1))
41.   (setq fil (open fname "w"))
42.   (write-line (vl-princ-to-string fname) fil)
43.   (mapcar '(lambda (x) (write-line x fil)) (reverse data))
44.   (close fil)
45.   (princ)
46. )