Author Topic: Bearing Orientation and distanse to *.txt  (Read 7546 times)

0 Members and 2 Guests are viewing this topic.

pedroantonio

  • Guest
Bearing Orientation and distanse to *.txt
« on: December 05, 2013, 06:08:56 AM »
i am searching for a bearing a distance lisp like the example *.gif

and then give the name of the export  txt file
« Last Edit: December 05, 2013, 06:16:56 AM by pedroantonio »

snownut2

  • Swamp Rat
  • Posts: 971
  • Bricscad 22 Ultimate
Re: Bearing Orientation and distanse to *.txt
« Reply #1 on: December 05, 2013, 06:45:17 AM »
Pedro,

This is a pretty simple task.  It seems you are requesting a lot of "Free" stuff lately, this would be a good time to try something on your own.  Once you show some initiative and get something started I am sure folks here would be happy to assist in any areas you are having trouble with.


Bruce

pedroantonio

  • Guest
Re: Bearing Orientation and distanse to *.txt
« Reply #2 on: December 05, 2013, 11:34:49 AM »
Ok snownut2 i agree with you . I try this

Code - Auto/Visual Lisp: [Select]
  1. (defun c:bear2txt (/ *error* p1 p11 p2 p21 p3 p31 d1 out del)
  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)) "ang(p1,p3,p2)" "ang(p1,p2,p3)")
  8.   )
  9.   (while (setq p3 (getpoint p1 (strcat "\nPick point :")))
  10.     (setq p3l (getstring "\nEnter Label of point: "))
  11.     (setq d1 (rtos (distance p1 p3) 2 2)) data))
  12.     (princ)
  13.    ((setq out ((vl-filename-base (getvar 'dwgname))) ".txt") del ",")
  14.   (princ)
  15.  

And i have this error

[CHECKING TEXT <Untitled-2> loading...]
....
; error: too few arguments in SETQ: (SETQ OUT (( ... )) ".txt")
..


Any ideas?

dgorsman

  • Water Moccasin
  • Posts: 2437
Re: Bearing Orientation and distanse to *.txt
« Reply #3 on: December 05, 2013, 02:38:45 PM »
LISP works from the inside bracket out.  So, find the deepest nested function in the line where you have problems.  Put it at the command line, and check the result.  Is it what you expected?  If not, then what needs to be changed?  If it is providing the correct result, grab the next inner-most bracket and put that to the command line.  Repeat the process until you come up to where it isn't giving the expected/correct result.
If you are going to fly by the seat of your pants, expect friction burns.

try {GreatPower;}
   catch (notResponsible)
      {NextTime(PlanAhead);}
   finally
      {MasterBasics;}

pedroantonio

  • Guest
Re: Bearing Orientation and distanse to *.txt
« Reply #4 on: December 06, 2013, 01:39:21 AM »
i try it but i still have problem.

pedroantonio

  • Guest
Re: Bearing Orientation and distanse to *.txt
« Reply #5 on: December 06, 2013, 06:18:15 PM »
I try and this but nothing !!

Code - Auto/Visual Lisp: [Select]
  1. (defun c:bear2txt (/ *error* 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.   (while (setq p3 (getpoint p1 (strcat "\nPick point :")))
  13.     (setq p3l (getstring "\nEnter Label of point: "))
  14.     (setq d1 (rtos (distance p1 p3) 2 2))
  15.     data
  16.   )
  17. )
  18. (setvar "cmdecho" 0)
  19. (setq fname (getfiled "Save Text File As:" "" "txt" 1))
  20. )
  21.   (strcat "\n* Text file " fname " \n has been created *")
  22.  
  23.   (princ)
  24. )
  25. )
  26.  

snownut2

  • Swamp Rat
  • Posts: 971
  • Bricscad 22 Ultimate
Re: Bearing Orientation and distanse to *.txt
« Reply #6 on: December 06, 2013, 07:51:39 PM »
Pedro,

Just what CAD program are you using ?

pedroantonio

  • Guest
Re: Bearing Orientation and distanse to *.txt
« Reply #7 on: December 07, 2013, 03:21:22 AM »
autocad 2012

snownut2

  • Swamp Rat
  • Posts: 971
  • Bricscad 22 Ultimate
Re: Bearing Orientation and distanse to *.txt
« Reply #8 on: December 07, 2013, 09:09:47 AM »
Pedro,

For LISP development you really need to become familiar with the VLIDE option in ACAD.  Just type VLIDE at the command prompt and a new window will open (the LISP Editor).  You can then open an existing LISP or DCL file for editing.  Using the EDITOR will help you check for syntax errors, and you can test your code right within the editor.

Taking some time to become familiar with this function will save you tons of headaches as you are developing LISP functions.

Bruce

pedroantonio

  • Guest
Re: Bearing Orientation and distanse to *.txt
« Reply #9 on: December 07, 2013, 04:26:47 PM »
I know that snownut2 and i use VLIDE . I do this chage and the VLIDE shows me no errors but when  i run in autocad this lisp  gives me  this error

; error: bad argument type: point: nil

Code - Auto/Visual Lisp: [Select]
  1. (defun c:bear2txt (/ *error* 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.   (while (setq p3 (getpoint p1 (strcat "\nPick point :")))
  13.     (setq p3l (getstring "\nEnter Label of point: "))
  14.     (setq d1 (rtos (distance p1 p3) 2 2))
  15.     data
  16.   )
  17. )
  18. (setvar "cmdecho" 0)
  19. (setq fname (getfiled "Save Text File As:" "" "txt" 1))
  20.  
  21.  

I don't know what to do please show me ......

Lee Mac

  • Seagull
  • Posts: 12914
  • London, England
Re: Bearing Orientation and distanse to *.txt
« Reply #10 on: December 07, 2013, 04:49:39 PM »
i use VLIDE . I do this chage and the VLIDE shows me no errors but when  i run in autocad this lisp  gives me  this error

; error: bad argument type: point: nil

I don't know what to do please show me ......

Follow this tutorial.

pedroantonio

  • Guest
Re: Bearing Orientation and distanse to *.txt
« Reply #11 on: December 08, 2013, 02:58:18 AM »
Thank you Lee for the tutorial.Helps me a lot.

Now the lisp have no errors but when i save the txt file on my desktop i can't  find it ?? I don't know . I thing that something is missing here !! :embarrassed:
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.   (while (setq p3 (getpoint p1 (strcat "\nPick point :")))
  13.     (setq p3l (getstring "\nEnter Label of point: "))
  14.     (setq d1 (rtos (distance p1 p3) 2 2))
  15.     data
  16.   )
  17. )
  18. (setvar "cmdecho" 0)
  19. (setq fname (getfiled "Save Text File As:" "" "txt" 1))
  20. )
  21.  
  22.  

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Bearing Orientation and distanse to *.txt
« Reply #12 on: December 08, 2013, 05:08:00 AM »
Quote
I thing that something is missing here !!

Looks to me like you aren't actually writing the data to a file ??
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Bearing Orientation and distanse to *.txt
« Reply #13 on: December 08, 2013, 05:10:08 AM »
and why are you using (vl-load-com)??
I suggest you read up on it's usage  ... both why and where.
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

pedroantonio

  • Guest
Re: Bearing Orientation and distanse to *.txt
« Reply #14 on: December 08, 2013, 01:03:55 PM »
I try and this but i have the same problem withthe file. I don't know. Perhaps is samething easy but i don;t know haw to do it !!

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.      (str fname (getfiled "Save Text File As:" "" "txt" 1) fil)
  23.  
  24.      (close fil)
  25.      (format stream content)
  26.    )
  27.     (princ)
  28.   )
  29. )
  30.  

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Bearing Orientation and distanse to *.txt
« Reply #15 on: December 08, 2013, 05:15:24 PM »
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.   (defun *error* (msg)
  3.     (if (= 'file (type fn))
  4.       (close fn)
  5.     )
  6.     (if (null (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
  7.       (princ (strcat "\nError: " msg))
  8.     )
  9.     (princ)
  10.   )
  11.   ;;------------------------------
  12.   (setq fname (getfiled "Save Text File As:" "" "txt" 1))
  13.   (setq vp  (getpoint "\nPick Base Vertex point: ")
  14.         vps (getstring "\nEnter Label Base Reference point: ")
  15.         ep  (getpoint vp "\nPick Base Second point: ")
  16.         eps (getstring "\nEnter Label of Second point: ")
  17.   )
  18.   (while (and (setq p3 (getpoint vp (strcat "\nPick Bearing point :")))
  19.               (setq s3 (getstring "\nEnter Label of point: "))
  20.          )
  21.     (if (> (car vp) (car ep))
  22.       (cal "incl_ANG=ANG(VP,P3,EP)")
  23.       (cal "incl_ANG=ANG(VP,EP,P3)")
  24.     )
  25.     (setq fn (open fname "a"))
  26.     (write-line (strcat vps ": " (vl-princ-to-string vp)) fn)
  27.     (write-line (strcat eps ": " (vl-princ-to-string ep)) fn)
  28.     (write-line (strcat s3 ": " (vl-princ-to-string p3)) fn)
  29.     (write-line (strcat "Distance " vps "->" s3 ": " (rtos (distance vp p3) 2 2)) fn)
  30.     (write-line (strcat "Angle "    eps "->" vps "->" s3 ": " (rtos incl_ang 2 6)) fn)
  31.     (write-line " ***" fn)
  32.     (close fn)
  33.   )
  34.   (*error* nil)
  35.   (princ)
  36.  
  37. )
  38.  
  39.  

Quote
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
 ***
« Last Edit: December 08, 2013, 05:19:45 PM by Kerry »
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

pedroantonio

  • Guest
Re: Bearing Orientation and distanse to *.txt
« Reply #16 on: December 08, 2013, 06:03:24 PM »
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

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Bearing Orientation and distanse to *.txt
« Reply #17 on: December 08, 2013, 06:48:58 PM »

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.

kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

pedroantonio

  • Guest
Re: Bearing Orientation and distanse to *.txt
« Reply #18 on: December 26, 2013, 06:56:52 PM »
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.      (str fname (getfiled "Save Text File As:" "" "txt" 1) fil)
  23.  
  24.      (close fil)
  25.      (format stream content)
  26.    )
  27.     (princ)
  28.   )
  29. )
  30.  

I want to export a txt file like this

point number,angle,distance

Thanks

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Bearing Orientation and distanse to *.txt
« Reply #19 on: December 26, 2013, 09:57:47 PM »
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.   (mapcar '(lambda (x) (write-line (vl-princ-to-string x) fil)) (reverse data))
  27.   (close fil)
  28.   (princ)
  29. )
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Bearing Orientation and distanse to *.txt
« Reply #20 on: December 26, 2013, 10:11:42 PM »
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.
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Bearing Orientation and distanse to *.txt
« Reply #21 on: December 27, 2013, 12:30:00 AM »
I merged the two threads.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

pedroantonio

  • Guest
Re: Bearing Orientation and distanse to *.txt
« Reply #22 on: December 28, 2013, 04:27:29 AM »
thank you CAB but this lisp gives me coordinate and distance, i need  angle and distance. How i can do it ?

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Bearing Orientation and distanse to *.txt
« Reply #23 on: December 28, 2013, 06:14:03 AM »
< .. > 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. ?
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

mailmaverick

  • Bull Frog
  • Posts: 493
Re: Bearing Orientation and distanse to *.txt
« Reply #24 on: December 28, 2013, 07:47:02 AM »
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

  • Swamp Rat
  • Posts: 971
  • Bricscad 22 Ultimate
Re: Bearing Orientation and distanse to *.txt
« Reply #25 on: December 28, 2013, 08:46:59 AM »
Almost sounds like you guys are doing someone's homework !

pedroantonio

  • Guest
Re: Bearing Orientation and distanse to *.txt
« Reply #26 on: December 28, 2013, 11:12:32 AM »
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
« Last Edit: December 28, 2013, 11:27:02 AM by pedroantonio »

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Bearing Orientation and distanse to *.txt
« Reply #27 on: December 29, 2013, 10:30:14 AM »
Instead of the (rtos) function, (angtos) should be used for the angle.

pedroantonio

  • Guest
Re: Bearing Orientation and distanse to *.txt
« Reply #28 on: December 29, 2013, 11:52:49 AM »
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

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Bearing Orientation and distanse to *.txt
« Reply #29 on: December 29, 2013, 12:42:21 PM »
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.   (mapcar '(lambda (x) (write-line x fil)) (reverse data))
  43.   (close fil)
  44.   (princ)
  45. )
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

mailmaverick

  • Bull Frog
  • Posts: 493
Re: Bearing Orientation and distanse to *.txt
« Reply #30 on: December 29, 2013, 12:45:50 PM »
Dear Pedro

Corrected code is as follows :-

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) " : ")
   )
     )
     (setq ang (/ (* (- (angle p1 p2) (angle p1 pn)) 200) pi))
     (write-line
       (strcat (itoa cnt)
       ","
       pnl
       ","
       (rtos ang 2 2)
       ","
       (rtos (distance p1 pn) 2 2)
       )
       fil
     )
     (setq cnt (1+ cnt))
      )
    )
  )
  (alert
    (strcat (itoa (- cnt 1)) " points written in file " fname)
  )
  (close fil)
  (princ)
)


pedroantonio

  • Guest
Re: Bearing Orientation and distanse to *.txt
« Reply #31 on: December 30, 2013, 02:46:11 AM »
Thank you mailmaverick your lisp work perfect

Don't forget  to thank CAB,Kerry ,Lee Mac,dgorsman,snownut2,roy_043 for there  advises.

Thank you all , Marry Christmas and Happy new year !!!!!!!!!!!!

pedroantonio

  • Guest
Re: Bearing Orientation and distanse to *.txt
« Reply #32 on: December 30, 2013, 03:59:05 AM »
Sorry again mailmaverick i find a little problem with Exterior Angle. Gives me negative angles. Can you fix this ? Here is my *dwg file to understand the problem ..

thanks


mailmaverick

  • Bull Frog
  • Posts: 493
Re: Bearing Orientation and distanse to *.txt
« Reply #33 on: December 30, 2013, 05:38:06 AM »
Dear Pedro

Problem of Negatives corrected !!!!!

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) " : ")
   )
     )
     (setq ang (/ (* (- (angle p1 p2) (angle p1 pn)) 200) pi))
     (if (< ang 0)
       (setq ang (+ ang 400))
     )
     (write-line
       (strcat (itoa cnt)
       ","
       pnl
       ","
       (rtos ang 2 2)
       "g,"
       (rtos (distance p1 pn) 2 2)
       )
       fil
     )
     (setq cnt (1+ cnt))
      )
    )
  )
  (alert
    (strcat (itoa (- cnt 1)) " points written in file " fname)
  )
  (close fil)
  (princ)
)


roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Bearing Orientation and distanse to *.txt
« Reply #34 on: December 30, 2013, 05:52:18 AM »
but i have an error with the angle
The (angtos) function takes the ANGBASE variable into account. This may explain the wrong values.
« Last Edit: December 30, 2013, 06:05:51 AM by roy_043 »

pedroantonio

  • Guest
Re: Bearing Orientation and distanse to *.txt
« Reply #35 on: December 30, 2013, 06:00:34 AM »
Thank you mailmaverick now works perfect

Happy new year to all ............