Draw Lines By Bearing

March 25, 2014

Hi guys!

I'm drawing lines by bearings.

e.g

455.25,

I'm looking for lisp to make it easier.

Maybe someone could help me out.

I'll attached a lisp from Ron Adams. It is a great lips, but isn't working properly.

Thank in advance

;;;Ron Adams

;;;Adams_etc@verizon.net

;;;•Detailed description:

;;;This program is used in Civil Drafting, to draw a property line, allowing you to input data

;;;from a deed to a drawing using the data in the written order within a deed and convert

;;;that same data to the order as needed by AutoCAD.

;;;•Software name: AutoCAD

;;;•Software version number: 12 through 2010

;;;•Files and functions necessary for tip to run independently (if any). none



;;;*******************************************************                                   Command: DC

(defun c:DC ( / LR1 DG MN SC LR2 LGN NPT PT1)
 (setq LR1 (getstring "\nFirst direction N or S..."))
 (setq DG (getstring "\nNumber of Degrees required..."))
 (setq MN (getstring "\nNumber of Minutes required..."))
 (setq SC (getstring "\nNumber of Seconds required..."))
 (setq LR2 (getstring "\nLast direction E or W..."))
 (setq LGN (getstring "\nLength of line..."))
 (setq NPT (strcat "@" LGN "<" LR1 DG "d" MN "'" SC "\"" LR2))
 (setvar "osmode" 1)
 (SETQ PT1 (GETPOINT "\nSelect a new point or the last line endpoint..." ))
 (COMMAND "LINE" PT1 npt "")
 (princ)
)
;;;*******************************************************

March 25, 2014

Madruga_SP

Not a very nice piece of code.

Try like this:

(defun c:DC ( / LR1 DG MN SC LR2 LGN NPT PT1)
 (while  (not (= "" (setq lr1 (getstring "\nFirst direction N or S..."))))
    (setq DG (getstring "\nNumber of Degrees required..."))
    (setq MN (getstring "\nNumber of Minutes required..."))
    (setq SC (getstring "\nNumber of Seconds required..."))
    (setq LR2 (getstring "\nLast direction E or W..."))
    (setq LGN (getstring "\nLength of line..."))
    (setq NPT (strcat "@" LGN "<" LR1 DG "d" MN "'" SC "\"" LR2))
    (setvar "osmode" 1)
    (SETQ PT1 (GETPOINT "\nSelect a new point or ENTER for last line endpoint..." ))
    (if (not pt1) (setq pt1 p2))
    (COMMAND "LINE" PT1 npt "")
    (setq p2 (cdr (assoc 11 (entget (entlast)))))
 )   
)

ymg

March 25, 2014

Hi ymg,

Thank you for the very quick replay.

Thank you for the assistence.

I’d like to make a improve the code, and I need your assistance.

After I pick the first line, I’d like to next line that insert the bearing pick the endpoint to the first line.

Maybe a polyline instead of a line, could be better.

Did you understand what I mean?

Sorry for my poor English

March 26, 2014

Madruga_SP,

Try this. Here the angle are entered Calculator Style

followed by the distance.

For example n45.3030e 125.632 is equivalent n45d30'30" with a distance of 125.632.

The space after the e is optionnal.

You also have the option to enter "C" to close the polyline or "U" to go back to the previous line.

If you undo beyond the first point the routine will probably go into error.

; dmsin    by ymg                                                   ;
;                                                                   ;
; Interpret a real number as an angle                               ;
; Calculator style ->dd.mmss                                        ;
; Returns the angle in radians                                      ;

(defun dmsin (a  / d m s)
  (setq d (fix a)
        m (* (- a d) 100)
        s (* (- m (fix m)) 100)
        m (fix m)
  )
  (* pi (/ (+ d (/ (+ m (/ s 60)) 60)) 180))
)

; bdin     by ymg                                                   ;
;                                                                   ;
; Let you enter Bearing and Distance as a                           ;
; single string Calculator style.                                   ;
;          (Ndd.mmssE 120.365)                                      ;
;                                                                   ;
; Returns a list (Angle Distance) where,                            ;
; the angle is in radians.                                          ;
;                                                                   ;
; Requires subroutine dmsin                                         ;

(defun bdin (s / a d)
  (setq s (strcase (vl-string-trim " " s))
        ; Required so that E is not interpreted as an exponent     ;
        s (vl-string-subst "Z" "E" s) 
        a (if (= (substr s 1 1) "N") 0 pi)
  )      
  (if (vl-string-position (ascii "Z") s)
     (setq a (+ a (dmsin (atof (substr s 2))))
           d (atof (substr s (+ (vl-string-position (ascii "Z") s) 2)))
     )      
     (setq a (- a (dmsin (atof (substr s 2))))
           d (atof (substr s (+ (vl-string-position (ascii "W") s) 2)))
     )
  )   
  (list a d)
)

;; angbd   function to respect ANGBASE / ANGDIR by ymg              ;
;; Modified from Lee Mac's _angle function                          ;

(defun angbd (a)
   (rem (+ pi pi ((if (zerop (getvar 'ANGDIR)) + -) (- a (getvar 'ANGBASE))))
        (+ pi pi)
   )
)
 

(defun c:bd ( / bd p1)
 (while (setq sp (getpoint "\nSelect a Starting Point: "))
     (command "_PLINE" sp)
     (while (and (not (equal p1 sp 0.01))              
                 (not (equal "" (setq bd (strcase (getstring "\nEnter Bearing Segment: ")))))
            )
         (if (not p1) (setq p1 sp))
         (cond
            ((equal bd "C") (command (setq p1 sp)))
            ((equal bd "U") (command "U")
                            (setq p1 (getvar 'LASTPOINT))
                            (if (equal p1 sp) (setq p1 nil))
            ) 
            ((equal bd "" ) (command "")(setq sp nil))
            (t (setq bd (bdin bd))
               (command (setq p1 (polar p1 (angbd (car bd)) (cadr bd)))))
         )     
     )      
 )
 (command "") 
)

ymg

March 26, 2014

Thank you very much ymg,

It's better than I thoughts! You deserve a kudo.

Could you fix just one thing in your code, please?

The angle SE and SW are reversed.

File Attached

bearing.dwg

March 26, 2014

Madruga_SP,

Sorry! about that, check that one:

; dmsin    by ymg                                                   ;
;                                                                   ;
; Interpret a real number as an angle                               ;
; Calculator style ->dd.mmss                                        ;
; Returns the angle in radians                                      ;

(defun dmsin (a  / d m s)
  (setq d (fix a)
        m (* (- a d) 100)
        s (* (- m (fix m)) 100)
        m (fix m)
  )
  (* pi (/ (+ d (/ (+ m (/ s 60)) 60)) 180))
)

; bdin     by ymg                                                   ;
;                                                                   ;
; Let you enter Bearing and Distance as a                           ;
; single string Calculator style.                                   ;
;          (Ndd.mmssE 120.365)                                      ;
;                                                                   ;
; Returns a list (Angle Distance) where,                            ;
; the angle is in radians.                                          ;
;                                                                   ;
; Requires subroutine dmsin                                         ;

(defun bdin (s / a d)
  (setq s (strcase (vl-string-trim " " s))
        ; Required so that E is not interpreted as an exponent     ;
        s (vl-string-subst "Z" "E" s)
  )
  (or (setq p (vl-string-position (ascii "Z") s))
      (setq p (- (vl-string-position (ascii "W") s)))
  )    
  (if (vl-string-position (ascii "N") s)
     (if (minusp p)
        (setq a (- (dmsin (atof (substr s 2)))))
        (setq a (dmsin (atof (substr s 2))))       
     )
     (if (minusp p)
        (setq a (+ pi (dmsin (atof (substr s 2)))))
        (setq a (- pi (dmsin (atof (substr s 2))))) 
     )   
  )      
  (setq d (atof (substr s (+ (abs p) 2))))      
  (list a d)
)

;; angbd   function to respect ANGBASE / ANGDIR by ymg              ;
;; Modified from Lee Mac's _angle function                          ;

(defun angbd (a)
   (rem (+ pi pi ((if (zerop (getvar 'ANGDIR)) + -) (- a (getvar 'ANGBASE))))
        (+ pi pi)
   )
)
 

(defun c:bd ( / bd p1)
 (while (setq sp (getpoint "\nSelect a Starting Point: "))
     (command "_PLINE" sp)
     (while (and (not (equal p1 sp 0.01))              
                 (not (equal "" (setq bd (strcase (getstring "\nEnter Bearing Segment: ")))))
            )
         (if (not p1) (setq p1 sp))
         (cond
            ((equal bd "C") (command (setq p1 sp)))
            ((equal bd "U") (command "U")
                            (setq p1 (getvar 'LASTPOINT))
                            (if (equal p1 sp) (setq p1 nil))
            ) 
            ((equal bd "" ) (command "")(setq sp nil))
            (t (setq bd (bdin bd))
               (command (setq p1 (polar p1 (angbd (car bd)) (cadr bd)))))
         )     
     )      
 )
 (command "") 
)

ymg

March 26, 2014

Thank you very much,

The code is amazing and fast!

Reagards

March 26, 2014

ymg,

I'm so sorry bother you again. But the code isn't work properly, now NW and SE angle are reversed.

I don't know if I'm doing something wrong,I need a assistence.

The image attached, shows the drawing units to the bearings works.

Thank in advance

March 27, 2014

Maduga_SP,

Your Base angle should be set should be set to North,

and Angle Direction to clockwise.

Here I've added an Evgenyi's Error Handler and setting

at the beginning for angbase and angdir.

Upon completion your setiing revert to the initial setting.

; dmsin    by ymg                                                   ;
;                                                                   ;
; Interpret a real number as an angle                               ;
; Calculator style ->dd.mmss                                        ;
; Returns the angle in radians                                      ;

(defun dmsin (a  / d m s)
  (setq d (fix a)
        m (* (- a d) 100)
        s (* (- m (fix m)) 100)
        m (fix m)
  )
  (* pi (/ (+ d (/ (+ m (/ s 60)) 60)) 180))
)

; bdin     by ymg                                                   ;
;                                                                   ;
; Let you enter Bearing and Distance as a                           ;
; single string Calculator style.                                   ;
;          (Ndd.mmssE 120.365)                                      ;
;                                                                   ;
; Returns a list (Angle Distance) where,                            ;
; the angle is in radians.                                          ;
;                                                                   ;
; Requires subroutine dmsin                                         ;

(defun bdin (s / a d)
  (setq s (strcase (vl-string-trim " " s))
        ; Required so that E is not interpreted as an exponent     ;
        s (vl-string-subst "Z" "E" s)
  )
  (or (setq p (vl-string-position (ascii "Z") s))
      (setq p (- (vl-string-position (ascii "W") s)))
  )    
  (if (vl-string-position (ascii "N") s)
     (if (minusp p)
        (setq a (- (dmsin (atof (substr s 2)))))
        (setq a (dmsin (atof (substr s 2))))       
     )
     (if (minusp p)
        (setq a (+ pi (dmsin (atof (substr s 2)))))
        (setq a (- pi (dmsin (atof (substr s 2))))) 
     )   
  )      
  (setq d (atof (substr s (+ (abs p) 2))))      
  (list a d)
)

;; angbd   function to respect ANGBASE / ANGDIR by ymg              ;
;; Modified from Lee Mac's _angle function                          ;

(defun angbd (a)
   (rem (+ pi pi ((if (zerop (getvar 'ANGDIR)) + -) (- a (getvar 'ANGBASE))))
        (+ pi pi)
   )
)
 

(defun c:bd ( / bd p1)
 (vl-load-com)
  
 ;;; Error Handler by ElpanovEvgenyi                                       ; 
 (defun *error* (msg)
    (mapcar 'eval errl)
    (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")))
       (princ (strcat "\nError: " msg))
    )
    (and *AcadDoc* (vla-endundomark *AcadDoc*))
    (princ)
 )
    
 (setq errl '("OSMODE" "CMDECHO" "ANGDIR" "ANGBASE")
       errl (mapcar (function (lambda (a) (list 'setvar a (getvar a)))) errl)
 )

 (or *AcadDoc*
       (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object)))
 )
    
    
 (vla-startundomark *AcadDoc*)	 

 (setvar 'ANGDIR 1)
 (setvar 'ANGBASE (/ pi 2))
 (setvar 'OSMODE 0)
  
 (while (setq sp (getpoint "\nSelect a Starting Point: "))
     (command "_PLINE" sp)
     (while (and (not (equal p1 sp 0.01))              
                 (not (equal "" (setq bd (strcase (getstring "\nEnter Bearing Segment: ")))))
            )
         (if (not p1) (setq p1 sp))
         (cond
            ((equal bd "C") (command (setq p1 sp)))
            ((equal bd "U") (command "U")
                            (setq p1 (getvar 'LASTPOINT))
                            (if (equal p1 sp) (setq p1 nil))
            ) 
            ((equal bd "" ) (command "")(setq sp nil))
            (t (setq bd (bdin bd))
               (command (setq p1 (polar p1 (angbd (car bd)) (cadr bd)))))
         )     
     )      
 )
 (command "")
 (*error* nil) 
)

March 27, 2014

...Your Base angle should be set should be set to North,
and Angle Direction to clockwise....

Perhaps this is the source of the problem. The default setting for AutoCAD is base angle at East, and angles counterclockwise. With this setting, the Surveyors angles work perfectly.

Perhaps programmers should allow for the lisp to work with AutoCAD default settings instead of presuming the user has to change the default, which they (the user) would have no reason to do. Also changing the angle settings introduces other effects, such as text direction.

March 27, 2014

eldon,

If you look at the last post #9, settings have been added

in the routine.

They revert back on completion of routine.

ymg

March 27, 2014

If you look at the last post #9, settings have been added
in the routine.

They revert back on completion of routine.

ymg

Then why was the OP complaining that the angles were coming in wrong, and you were telling him to alter the default?

If the routine has since been altered, then you should delete this bit of advice.

Your Base angle should be set should be set to North,
and Angle Direction to clockwise.

March 27, 2014

OP really pleased with the goal!!

Thank you very much.

The code isn't depend on the formatting in drawing unit, the correct format is into the code. It's really nice.

really clever way, by the way.

I'm really embarassing to ask you one more favor, but my learning about lisp is too poor and I can't doing that modification.

I have a code that I use very often, design by azimuth and distance, it's a really good code!

I'd like to make the same modification as you did. Set the format units into the code.

Could you make that modification for me, please?

Thank in advance.

The image attached is the set format to design by azimuth.

File attached

AZI-desenha azimute e distancia.LSP

March 27, 2014

Madruga_SP,

There you go.

(defun C:AZI (/ point ds a d m s dec_deg osm)
  (vl-load-com)
  
 ;;; Error Handler by ElpanovEvgenyi                                       ; 
 (defun *error* (msg)
    (mapcar 'eval errl)
    (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")))
       (princ (strcat "\nError: " msg))
    )
    (and *AcadDoc* (vla-endundomark *AcadDoc*))
    (princ)
 )
    
 (setq errl '("OSMODE" "CMDECHO" "ANGDIR" "ANGBASE")
       errl (mapcar (function (lambda (a) (list 'setvar a (getvar a)))) errl)
 )

 (or *AcadDoc*
       (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object)))
 )
    
    
 (vla-startundomark *AcadDoc*)	 
 (setvar "cmdecho" 0)
 (setvar 'ANGDIR 1)
 (setvar 'ANGBASE (/ pi 2))
 (setvar 'OSMODE 0)
 (if (setq POINT (getpoint "\nSeleciona o ponto de início:"))
    (progn
        (vla-startundomark *AcadDoc*)	 
        (setvar "cmdecho" 0)
        (setvar 'ANGDIR 1)
        (setvar 'ANGBASE (/ pi 2))
        (setvar 'OSMODE 0)
   	 (command "_Pline" point)
    (while (> (getvar "CMDACTIVE") 0)	
	(if (and (setq ds (getdist (getvar 'Lastpoint) "\nDigita a distância: "))
	         (setq a (getreal "\nDigita o Azimute [GG.MMSS] : ")))
              (progn	
	      (setq d (fix a))
	      (setq m (fix (* 100 (- a d))))
	      (setq s (* 100 (- (* 100 (- a d)) m)))
	      (setq dec_deg (+ d (/ m 60.0) (/ s 3600.0)))
              (command (strcat "@" (rtos ds) "<" (angtos (angtof (rtos dec_deg 2 4) 0) 1 4)))
              )
          	(command "")
          )
      )
       )
  )
  (*error* nil)
)

We could also modify bd and say you would

enter add.mmssd 120.369, it could interpret it as an azimut.

ymg

March 27, 2014

Wonderful job my friend!

Thank you very much.

We could also modify bd and say you would
enter add.mmssd 120.369, it could interpret it as an azimut.

you mean put these 2 codes into in 1?

Would be amazing!!!

March 27, 2014

Madruga_SP,

So try this.

Now you can enter an azimut or a Bearing

; dmsin    by ymg                                                   ;
;                                                                   ;
; Interpret a real number as an angle                               ;
; Calculator style ->dd.mmss                                        ;
; Returns the angle in radians                                      ;

(defun dmsin (a  / d m s)
  (setq d (fix a)
        m (* (- a d) 100)
        s (* (- m (fix m)) 100)
        m (fix m)
  )
  (* pi (/ (+ d (/ (+ m (/ s 60)) 60)) 180))
)

; bdin     by ymg                                                   ;
;                                                                   ;
; Let you enter Bearing or Azimut and Distance                          ;
; as a single string Calculator style.                                   ;
;          (Ndd.mmssE 120.365)                                      ;
;          (Add.mmssD 120.365)
;                                                                   ;
; Returns a list (Angle Distance) where,                            ;
; the angle is in radians.                                          ;
;                                                                   ;
; Requires subroutine dmsin                                         ;

(defun bdin (s / a d p)
  (setq s (strcase (vl-string-trim " " s))
        ; Required so that E is not interpreted as an exponent     ;
        s (vl-string-subst "Z" "E" s)
  )
  (or (setq p (vl-string-position (ascii "Z") s))
      (setq p (if (setq p (vl-string-position (ascii "W") s)) (- p)))
      (setq p (vl-string-position (ascii "D") s))
  )
  (cond
     ((vl-string-position (ascii "A") s)
                (setq a (dmsin (atof (substr s 2 (- p 1)))))
     )
     ((vl-string-position (ascii "N") s)
                (if (minusp p)
                   (setq a (- (dmsin (atof (substr s 2)))))
                   (setq a (dmsin (atof (substr s 2))))       
                )
     )
     ((vl-string-position (ascii "S") s)
                (if (minusp p)
                   (setq a (+ pi (dmsin (atof (substr s 2)))))
                   (setq a (- pi (dmsin (atof (substr s 2))))) 
                )   
     )
  )
  (setq d (atof (substr s (+ (abs p) 2))))    
  (if (and a d) (list a d))
)

;; angbd   function to respect ANGBASE / ANGDIR by ymg              ;
;; Modified from Lee Mac's _angle function                          ;

(defun angbd (a)
   (rem (+ pi pi ((if (zerop (getvar 'ANGDIR)) + -) (- a (getvar 'ANGBASE))))
        (+ pi pi)
   )
)
 

(defun c:bd ( / bd p1)
 (vl-load-com)
  
 ;;; Error Handler by ElpanovEvgenyi                                       ; 
 (defun *error* (msg)
    (mapcar 'eval errl)
    (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")))
       (princ (strcat "\nError: " msg))
    )
    (and *AcadDoc* (vla-endundomark *AcadDoc*))
    (princ)
 )
    
 (setq errl '("OSMODE" "CMDECHO" "ANGDIR" "ANGBASE")
       errl (mapcar (function (lambda (a) (list 'setvar a (getvar a)))) errl)
 )

 (or *AcadDoc*
       (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object)))
 )
    
    
 (vla-startundomark *AcadDoc*)	 

 (setvar 'ANGDIR 1)
 (setvar 'ANGBASE (/ pi 2))
 (setvar 'OSMODE 0)
  
 (while (setq sp (getpoint "\nSelect a Starting Point: "))
     (command "_PLINE" sp)
     (while (and (not (equal p1 sp 0.01))              
                 (not (equal "" (setq bd (strcase (getstring "\nEnter a Segment: ")))))
            )
         (if (not p1) (setq p1 sp))
         (cond
            ((equal bd "C") (command (setq p1 sp)))
            ((equal bd "U") (command "U")
                            (setq p1 (getvar 'LASTPOINT))
                            (if (equal p1 sp) (setq p1 nil))
            ) 
            ((equal bd "" ) (command "")(setq sp nil))
            (t (if (setq bd (bdin bd))
                  (command (setq p1 (polar p1 (angbd (car bd)) (cadr bd))))
                  (alert "Invalid Input...!")
               )
            ) 
         )     
     )      
 )
 (command "")
 (*error* nil) 
)

Give it a test, I did not do much error testing.

ymg

Edited March 27, 2014 by ymg3

March 27, 2014

ymg,

Let you enter Bearing and Distance as a ;
; single string Calculator style. ;

; (Ndd.mmssE 120.365)

and azimuth?

March 27, 2014

Yes, you can enter Azimut as A180.3030D 120.368

I've corrected the comments above

ymg

March 27, 2014

Hi

I didn't see the comments..

Thank you ymg,

Perfect!

Regards

April 6, 2020

I am out of my element on this subject, but I believe one of these LISP provided here would work with my survey table?

It seems like surveys could be done in bearing or azimut - news to me.

Which LISP would best work for Azimut and distances? I can't figure out how to make these LISP work.

Thanks in advance!

Sign In

Draw Lines By Bearing

Recommended Posts

Madruga_SP

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

ymg3

Madruga_SP

ymg3

Madruga_SP

ymg3

Madruga_SP

Madruga_SP

ymg3

eldon

ymg3

eldon

Madruga_SP

ymg3

Madruga_SP

ymg3

Madruga_SP

ymg3

Madruga_SP

Koko_NYC

Join the conversation

Tutorials

Forums

Activity