Page 3 of 4 FirstFirst 1234 LastLast
Results 21 to 30 of 39

Thread: Surveying Bearing/Distance LISP Routine

  1. #21
    Member
    Join Date
    2005-10
    Posts
    3
    0 Did you find this post helpful? Yes

    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
    0 Did you find this post helpful? Yes

    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
    0 Did you find this post helpful? Yes

    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
    0 Did you find this post helpful? Yes

    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'~
    "The whole problem with the world is that fools and fanatics are always
    so certain of themselves, and wiser people so full of doubts."
    Bertrand Russell

  5. #25
    Active Member
    Join Date
    2001-12
    Posts
    55
    0 Did you find this post helpful? Yes

    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
    0 Did you find this post helpful? Yes

    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
    "The whole problem with the world is that fools and fanatics are always
    so certain of themselves, and wiser people so full of doubts."
    Bertrand Russell

  7. #27
    Member
    Join Date
    2012-07
    Posts
    36
    0 Did you find this post helpful? Yes

    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
    Certified AUGI Addict rkmcswain's Avatar
    Join Date
    2004-09
    Location
    Houston
    Posts
    7,996
    0 Did you find this post helpful? Yes

    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

  9. #29
    I could stop if I wanted to
    Join Date
    2003-11
    Posts
    433
    0 Did you find this post helpful? Yes

    Default Re: Surveying Bearing/Distance LISP Routine

    See file below.
    Attached Files Attached Files

  10. #30
    Member
    Join Date
    2012-07
    Posts
    36
    0 Did you find this post helpful? Yes

    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 4 FirstFirst 1234 LastLast

Similar Threads

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

Posting Permissions

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