See the top rated post in this thread. Click here

Page 3 of 6 FirstFirst 123456 LastLast
Results 21 to 30 of 60

Thread: Surveying Bearing/Distance LISP Routine

  1. #21
    Member
    Join Date
    2005-10
    Posts
    3
    Login to Give a bone
    0

    Default Re: Surveying Bearing/Distance LISP Routine

    You don't need a lisp routine in Civil3D. General/Add labels/ then choose Feature: Line and Curve. Pick the line to label the bearing and distance. Edit the Command Line in Toolspace/Settings/General/Label Style/Line to have the label the way you want it to show.

    Of course, you must have a line first to label. I am using Civil3D 2009.

  2. #22
    Woo! Hoo! my 1st post
    Join Date
    2004-08
    Posts
    1
    Login to Give a bone
    0

    Default Re: Surveying Bearing/Distance LISP Routine

    Quote Originally Posted by hilln View Post
    You don't need a lisp routine in Civil3D. General/Add labels/ then choose Feature: Line and Curve. Pick the line to label the bearing and distance. Edit the Command Line in Toolspace/Settings/General/Label Style/Line to have the label the way you want it to show.

    Of course, you must have a line first to label. I am using Civil3D 2009.
    What about if I need to label just parts of that line and than again parts of that line. They should left the ability to put labels between two points.

  3. #23
    Woo! Hoo! my 1st post
    Join Date
    2012-04
    Posts
    1
    Login to Give a bone
    0

    Angry Re: Surveying Bearing/Distance LISP Routine

    Is there is a lisp function that writes bearing and distance in metric without the foot symbol and and quadrant bearings

  4. #24
    AUGI Addict fixo's Avatar
    Join Date
    2005-05
    Location
    Pietari, Venäjä
    Posts
    1,269
    Login to Give a bone
    0

    Default Re: Surveying Bearing/Distance LISP Routine

    Try this code, not seriously tested though
    Code:
    ;; local defuns
    
    ;;--------------------------------------------;;
    
    ;; draw text
    (defun vk_true_text (txt t0 h ug just / elast)
        (setq elast (entlast))              
        (if (= (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))) 0.0)
          (if (/= (strcase just) "L")       
            (vl-cmdf "_.TEXT" "_J" just t0 h ug txt)
            (vl-cmdf "_.TEXT" t0 h ug txt)
          ) ;_  if
          (if (/= (strcase just) "L")      
            (vl-cmdf "_.TEXT" "_J" just t0 ug txt)
            (vl-cmdf "_.TEXT" t0 ug txt)
          ) ;_  if
        ) ;_  if
        (if (/= elast (entlast))
          (entlast)
          nil
        ) ;_  if
      )
    ;;--------------------------------------------;;
    
    ; Convert value in radians to degrees
    (defun rtd (a)
      (* 180.0 (/ a pi))
    )
    
    ;;-------------------------------------   main part   ---------------------------------;;
    (defun C:BEAR(/ a ang b curth dist elist en ent gkw mp mp2 osm p1 p2 strang strdist txh)
    (setq osm (getvar "osmode"))
    (setvar "osmode" 0)
    (setq curth (getvar "dimtxt"))
    (initget 6)
    (setq txh (getreal
    	    (strcat "\nEnter the text height <" (rtos curth) ">: ")
    	  )
    )
    (cond ((not txh) (setq txh curth)))
    
    (initget 1 "Select Enter")
    (setq gkw (getkword
    	    "\nSelect line or Enter two points (Select/Enter) <S>: "
    	  )
    )
    (if (eq "Select" gkw)
      (progn
        (setq ent (entsel "\nSelect line: "))
        (setq en (car ent))
        (setq elist (entget en))
        (setq p1	  (cdr (assoc 10 elist))
    	  p2	  (cdr (assoc 11 elist))
    	  mp	  (mapcar '(lambda (a b) (/ (+ a b) 2)) p1 p2)
    	  ang	  (angle p1 p2)
    
    	  dist	  (distance p1 p2)
    	  strdist (rtos dist 2 3)
    	  strang  (angtos ang 0 2)
        )
    
        (if	(< (/ pi 2) ang (* pi 1.5))
          (setq ang (+ pi ang))
        )
        (setq mp2 (polar mp (- ang (/ pi 2)) txh)
    	  mp  (polar mp (+ (/ pi 2) ang) (/ txh 2))
        )
    
        (vk_true_text strdist mp txh (rtd ang) "BC")
    
        (vk_true_text strang mp2 txh (rtd ang) "TC")
    
      )
      (progn
        (setq p1 (getpoint "\nSpecify a first point: "))
        (setq p2 (getpoint p1 "\nSpecify a second point: "))
        (setq mp	  (mapcar '(lambda (a b) (/ (+ a b) 2)) p1 p2)
    	  ang	  (angle p1 p2)
    
    
    	  dist	  (distance p1 p2)
    	  strdist (rtos dist 2 3)
    	  strang  (angtos ang 0 2)
        )
        (if	(< (/ pi 2) ang (* pi 1.5))
          (setq ang (+ pi ang))
        )
        (setq mp2 (polar mp (- ang (/ pi 2)) txh)
    	  mp  (polar mp (+ (/ pi 2) ang) (/ txh 2))
        )
    
        (vk_true_text strdist mp txh (rtd ang) "BC")
    
        (vk_true_text strang mp2 txh (rtd ang) "TC")
      )
    )
    
    
     (setvar "osmode" osm)
      (princ)
      )
          
    (prompt "\nType BEAR to start command")
    (prin1)
    ~'J'~

  5. #25
    Active Member
    Join Date
    2015-08
    Posts
    59
    Login to Give a bone
    0

    Default Re: Surveying Bearing/Distance LISP Routine

    Quote Originally Posted by fixo View Post
    Try this code, not seriously tested though
    Code:
    ;; local defuns
    
    ;;--------------------------------------------;;
    
    ;; draw text
    (defun vk_true_text (txt t0 h ug just / elast)
        (setq elast (entlast))              
        (if (= (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))) 0.0)
          (if (/= (strcase just) "L")       
            (vl-cmdf "_.TEXT" "_J" just t0 h ug txt)
            (vl-cmdf "_.TEXT" t0 h ug txt)
          ) ;_  if
          (if (/= (strcase just) "L")      
            (vl-cmdf "_.TEXT" "_J" just t0 ug txt)
            (vl-cmdf "_.TEXT" t0 ug txt)
          ) ;_  if
        ) ;_  if
        (if (/= elast (entlast))
          (entlast)
          nil
        ) ;_  if
      )
    ;;--------------------------------------------;;
    
    ; Convert value in radians to degrees
    (defun rtd (a)
      (* 180.0 (/ a pi))
    )
    
    ;;-------------------------------------   main part   ---------------------------------;;
    (defun C:BEAR(/ a ang b curth dist elist en ent gkw mp mp2 osm p1 p2 strang strdist txh)
    (setq osm (getvar "osmode"))
    (setvar "osmode" 0)
    (setq curth (getvar "dimtxt"))
    (initget 6)
    (setq txh (getreal
    	    (strcat "\nEnter the text height <" (rtos curth) ">: ")
    	  )
    )
    (cond ((not txh) (setq txh curth)))
    
    (initget 1 "Select Enter")
    (setq gkw (getkword
    	    "\nSelect line or Enter two points (Select/Enter) <S>: "
    	  )
    )
    (if (eq "Select" gkw)
      (progn
        (setq ent (entsel "\nSelect line: "))
        (setq en (car ent))
        (setq elist (entget en))
        (setq p1	  (cdr (assoc 10 elist))
    	  p2	  (cdr (assoc 11 elist))
    	  mp	  (mapcar '(lambda (a b) (/ (+ a b) 2)) p1 p2)
    	  ang	  (angle p1 p2)
    
    	  dist	  (distance p1 p2)
    	  strdist (rtos dist 2 3)
    	  strang  (angtos ang 0 2)
        )
    
        (if	(< (/ pi 2) ang (* pi 1.5))
          (setq ang (+ pi ang))
        )
        (setq mp2 (polar mp (- ang (/ pi 2)) txh)
    	  mp  (polar mp (+ (/ pi 2) ang) (/ txh 2))
        )
    
        (vk_true_text strdist mp txh (rtd ang) "BC")
    
        (vk_true_text strang mp2 txh (rtd ang) "TC")
    
      )
      (progn
        (setq p1 (getpoint "\nSpecify a first point: "))
        (setq p2 (getpoint p1 "\nSpecify a second point: "))
        (setq mp	  (mapcar '(lambda (a b) (/ (+ a b) 2)) p1 p2)
    	  ang	  (angle p1 p2)
    
    
    	  dist	  (distance p1 p2)
    	  strdist (rtos dist 2 3)
    	  strang  (angtos ang 0 2)
        )
        (if	(< (/ pi 2) ang (* pi 1.5))
          (setq ang (+ pi ang))
        )
        (setq mp2 (polar mp (- ang (/ pi 2)) txh)
    	  mp  (polar mp (+ (/ pi 2) ang) (/ txh 2))
        )
    
        (vk_true_text strdist mp txh (rtd ang) "BC")
    
        (vk_true_text strang mp2 txh (rtd ang) "TC")
      )
    )
    
    
     (setvar "osmode" osm)
      (princ)
      )
          
    (prompt "\nType BEAR to start command")
    (prin1)
    ~'J'~
    FIXO; I believe the angle reported by the program is the complement of the angle which needs to be reported. Angle needs to be reported from north or south, not east or west. (angle reported as 16.8 degrees, should be 73.2 degrees)
    Steve

  6. #26
    AUGI Addict fixo's Avatar
    Join Date
    2005-05
    Location
    Pietari, Venäjä
    Posts
    1,269
    Login to Give a bone
    0

    Default Re: Surveying Bearing/Distance LISP Routine

    Thank you Steve, but I'm not a math, I'm still waiting for OP response
    He wrote:
    >>
    Is there is a lisp function that writes bearing and distance in metric without the foot symbol and and quadrant bearings
    Oleg

  7. #27
    Active Member
    Join Date
    2012-07
    Posts
    56
    Login to Give a bone
    0

    Default Re: Surveying Bearing/Distance LISP Routine

    Hey, guys

    I need a lisp that label the azimuth & distance by picking a line?
    The azimuth is according to the position of UCS from the AutoCad2012.



    Kind Regards,

  8. #28
    Administrator rkmcswain's Avatar
    Join Date
    2004-09
    Location
    Earth
    Posts
    9,803
    Login to Give a bone
    0

    Default Re: Surveying Bearing/Distance LISP Routine

    Quote Originally Posted by fabricio_camargo84151122 View Post
    Hey, guys

    I need a lisp that label the azimuth & distance by picking a line?
    The azimuth is according to the position of UCS from the AutoCad2012.
    Take a look at
    http://forums.autodesk.com/t5/Visual...e/td-p/2668454
    R.K. McSwain | CAD Panacea |

  9. #29
    I could stop if I wanted to
    Join Date
    2003-11
    Posts
    450
    Login to Give a bone
    0

    Default Re: Surveying Bearing/Distance LISP Routine

    See file below.
    Attached Files Attached Files

  10. #30
    Active Member
    Join Date
    2012-07
    Posts
    56
    Login to Give a bone
    0

    Default Re: Surveying Bearing/Distance LISP Routine

    modelo.dwg

    Hello guys,
    Thanks for the help but I saw this lisp and didn't work.
    I need lisp that give me azimuth and distance: e.g. 25°26'23" - 15,30m.

    Following attached file as a model.
    Thanks.

Page 3 of 6 FirstFirst 123456 LastLast

Similar Threads

  1. Distance Lisp Routine Help
    By BCrouse in forum AutoLISP
    Replies: 53
    Last Post: 2018-03-21, 02:40 PM
  2. Annotate bearing/distance
    By justinxxvii in forum AutoCAD General
    Replies: 8
    Last Post: 2009-06-02, 09:35 AM
  3. Northing & Easting Miss Surveying Lisp routine
    By amazingb2003 in forum AutoLISP
    Replies: 6
    Last Post: 2008-04-23, 06:45 PM
  4. bearing and distance lables
    By eleonard in forum AutoCAD Civil 3D - General
    Replies: 1
    Last Post: 2007-04-24, 08:41 PM
  5. Annotation - Bearing and Distance - Civil
    By Mlabell in forum Dynamic Blocks - Sharing
    Replies: 9
    Last Post: 2007-04-05, 11:45 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •