Jump to content

List Bearing Distances-with extra setting

jason tay

By jason tay
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

jason tay Contributor

jason tay

Posted
Posted

Hi all guru ,can any one help to modify this lisp to add in extra function as below:

 

1.Onces we load the lisp

the Unit setting will be

-Type: Decimal

-Precision:3

-Angle type Deg/Min/Sec -Precision 0d00'00"

-Clockwise

-Direction North 270d0'

 

2.The Angle(Deg/Min/Sec) can be set for choice

-Round up (as existing )

-Not Round up

 

 

Thanks for all the help.

LIST BEARING DISTANCES.LSP

Guest Alan Cullen

Guest Alan Cullen

Posted
Posted

No offence Jason, but it would be easier to follow if it was in English. :lol: :P

 

That's nearly as bad as Tiger stealing my lisps, converting them to Swedish, then sending them back to me to make modifications. :twisted:

jason tay Contributor

jason tay

Posted
  • Author
Posted

:shock: oh sorry Alan, haa i for got to change it to english.:lol:

i will change it and re post again..:oops: :P

jason tay Contributor

jason tay

Posted
  • Author
Posted

Alan here i change it to english,:lol: i try to edit this lisp a bit and its got this " ; error: bad argument type: FILE nil "

at the end .what is the problem?

 

 

 
:; use to get bearing and distance of line/s
(DEFUN C:BD ()
(PROGN
(COMMAND "OSNAP" "NONE")
(Princ "List out Bearing Distances \n")
(if (not (tblsearch "layer" "BEARING DISTANCES"))
  (command  "layer" "m" "BEARING DISTANCES" "c" "3" "" "")
  (if (/= (getvar "clayer") "BEARING DISTANCES")
(command  "layer" "s" "BEARING DISTANCES" "" ))
) 
(SETQ P (SSGET))
(IF P (PROGN
(SETQ SKF (GETREAL "\n1 UNITs on SCREEN = ? UNIT for plotting  "))
(SETQ THT (GETDIST "\nSAIZ TULISAN ? "))
(SETQ NODEC (GETINT "\nDistance decimal ? "))
(SETQ YNBRG (STRCASE (GETSTRING Y "\nNeed bearing ? ")))
(SETQ L 0 N (SSLENGTH P) THTV (RTOS THT 2 3) SCMDE (GETVAR "CMDECHO"))
Ū(SETVAR "CMDECHO" 0)
(WHILE (< L N)
(SETQ E (ENTGET (SSNAME P L)))
(IF (= "LINE" (CDR (ASSOC 0 E))) (PROGN
(SETQ BL (CDR (ASSOC 10 E)) EL (CDR (ASSOC 11 E)))
(SETQ BRG (ANGLE BL EL) JAR (DISTANCE BL EL))
(SETQ JARL JAR)
(SETQ ROT (ANGLE BL EL))
(SETQ JARI (RTOS (* SKF JAR) 2 NODEC))
(IF (= YNBRG "N")
(PROGN
(SETQ CTT (POLAR (POLAR BL ROT (/ JAR 2)) (- ROT (* 0.5 PI)) THT))
(SETQ CT (POLAR (POLAR BL ROT (/ JAR 2)) (- ROT (* 0.5 PI)) (* 1.75 THT)))
(IF (< (* 0.5 PI) ROT (* 1.5 PI))
(PROGN
(SETQ ROT (ANGTOS (+ ROT PI)))
(COMMAND "TEXT" "C" CTT THTV ROT JARI))
(PROGN
(SETQ ROT (ANGTOS ROT))
(COMMAND "TEXT" "C" CT THTV ROT JARI))))
(PROGN
(SETQ BRG (- 450 (* 180 (/ BRG PI))))
(IF (<= 360 BRG)(SETQ BRG (- BRG 360)))
(SETQ BR (FIX BRG) MS (* 60 (- BRG BR)) MN (FIX MS))
(SETQ SE (* (FIX (+ (/ (* 60 (- MS MN)) 10) 0.5)) 10))
(IF (< 55 SE) (PROGN (SETQ MN (+ 1 MN))(SETQ SE 0)))
(IF (< 59 MN) (PROGN (SETQ BR (+ 1 BR))(SETQ MN 0)))
(SETQ BR (ITOA BR) MN (ITOA MN) SE (ITOA SE))
(IF (= 1 (STRLEN MN))(SETQ MN (STRCAT "0" MN)))
(IF (= 1 (STRLEN SE))(SETQ SE (STRCAT "0" SE)))
(SETQ BERING (STRCAT BR "%%D" MN (CHR 39) SE (CHR 34) ))
(SETQ BGT (* THT (STRLEN BERING)) JART (* THT (+ 2 (STRLEN JARI))) BR "L")
(IF (< JARL BGT) (PROGN
(IF (< PI ROT)
(PROGN
(SETQ CT (POLAR (POLAR BL ROT (- (/ JAR 2) (/ THT 4))) (+ ROT (* 0.5 PI)) THT))
(SETQ CTJ (POLAR (POLAR BL ROT (+ (/ JAR 2) (* 1.25 THT))) (+ ROT (* 0.5 PI)) THT))
(SETQ ROT (ANGTOS (+ ROT (* 0.5 PI))))
(COMMAND "TEXT" CT THTV ROT BERING)
(COMMAND "TEXT" CTJ THTV ROT JARI))
(PROGN
(SETQ CT (POLAR (POLAR BL ROT (+ (/ THT 4) (/ JAR 2))) (+ ROT (* 0.5 PI)) THT))
(SETQ CTJ (POLAR (POLAR BL ROT (- (/ JAR 2) (* 1.25 THT))) (+ ROT (* 0.5 PI)) THT))
(SETQ ROT (ANGTOS (- ROT (* 0.5 PI))))
Ū(COMMAND "TEXT" "R" CT THTV ROT BERING)
(COMMAND "TEXT" "R" CTJ THTV ROT JARI))
)
(SETQ BR "S")))
(IF (= BR "L") (PROGN
(SETQ CTB (POLAR (POLAR BL ROT (/ JAR 2)) (- ROT (* 0.5 PI)) (* 1.75 THT)))
(SETQ CT (POLAR (POLAR BL ROT (/ JAR 2)) (+ ROT (* 0.5 PI)) (* 0.75 THT)))
(SETQ CTC (POLAR (POLAR BL ROT (/ JAR 2)) (+ ROT (* 0.5 PI)) (* 1.75 THT)))
(SETQ CTD (POLAR (POLAR BL ROT (/ JAR 2)) (- ROT (* 0.5 PI)) (* 0.75 THT)))
(IF (> JARL (+ BGT JART)) (PROGN
(SETQ BERING (STRCAT BERING " " JARI))
(IF (< (* 0.5 PI) ROT (* 1.5 PI))
(PROGN
(SETQ ROT (ANGTOS (- ROT PI)))
(COMMAND "TEXT" "C" CTC THTV ROT BERING))
(PROGN
(SETQ ROT (ANGTOS ROT))
(COMMAND "TEXT" "C" CT THTV ROT BERING))))
(PROGN
(IF (< (* 0.5 PI) ROT (* 1.5 PI))
(PROGN
(SETQ ROT (ANGTOS (- ROT PI)))
(COMMAND "TEXT" "C" CTD THTV ROT JARI)
(COMMAND "TEXT" "C" CTC THTV ROT BERING))
(PROGN
(SETQ ROT (ANGTOS ROT))
(COMMAND "TEXT" "C" CT THTV ROT BERING)
(COMMAND "TEXT" "C" CTB THTV ROT JARI))))))
)))))
(SETQ L (1+ L))
)))
(TERPRI)
(SETVAR "CMDECHO" SCMDE))
(SETQ WS (READ-CHAR WSE))
(SETQ WS (READ-CHAR WSE))
(SETQ WS (READ-CHAR WSE))
(CLOSE WSE))

jason tay Contributor

jason tay

Posted
  • Author
Posted

Alan i dont know who is the author for this lisp, because i get it from my senior.

Guest Alan Cullen

Guest Alan Cullen

Posted
Posted

Okay, Jason,

 

A couple of things. Start indenting your code. For every right parenthesis, indent one space. for every left parenthesis, delete an indent space. I'll go through and do it in a minute. (I've got Tiger up my thingy at the moment).

 

Delete this line:

 

 

Also I suspect you may be missing a left parenthesis at the end.

Guest Alan Cullen

Guest Alan Cullen

Posted
Posted

Right, jason, I've had a chance to go through it. Try this, it is just to show indentation, I did not check you code:

 

:; use to get bearing and distance of line/s
(DEFUN C:BD ()
(PROGN
 (COMMAND "OSNAP" "NONE")
 (Princ "List out Bearing Distances \n")
 (if (not (tblsearch "layer" "BEARING DISTANCES"))
  (command  "layer" "m" "BEARING DISTANCES" "c" "3" "" "")
  (if (/= (getvar "clayer") "BEARING DISTANCES")
   (command  "layer" "s" "BEARING DISTANCES" "" )
 ))
 (SETQ P (SSGET))
 (IF P
  (PROGN
   (SETQ SKF (GETREAL "\n1 UNITs on SCREEN = ? UNIT for plotting  "))
   (SETQ THT (GETDIST "\nSAIZ TULISAN ? "))
   (SETQ NODEC (GETINT "\nDistance decimal ? "))
   (SETQ YNBRG (STRCASE (GETSTRING Y "\nNeed bearing ? ")))
   (SETQ L 0 N (SSLENGTH P) THTV (RTOS THT 2 3) SCMDE (GETVAR "CMDECHO"))
   (SETVAR "CMDECHO" 0)
   (WHILE (< L N)
    (SETQ E (ENTGET (SSNAME P L))
   )
   (IF (= "LINE" (CDR (ASSOC 0 E)))
    (PROGN
     (SETQ BL (CDR (ASSOC 10 E)) EL (CDR (ASSOC 11 E)))
     (SETQ BRG (ANGLE BL EL) JAR (DISTANCE BL EL))
     (SETQ JARL JAR)
     (SETQ ROT (ANGLE BL EL))
     (SETQ JARI (RTOS (* SKF JAR) 2 NODEC))
     (IF (= YNBRG "N")
      (PROGN
       (SETQ CTT (POLAR (POLAR BL ROT (/ JAR 2)) (- ROT (* 0.5 PI)) THT))
       (SETQ CT (POLAR (POLAR BL ROT (/ JAR 2)) (- ROT (* 0.5 PI)) (* 1.75 THT)))
       (IF (< (* 0.5 PI) ROT (* 1.5 PI))
        (PROGN
         (SETQ ROT (ANGTOS (+ ROT PI)))
         (COMMAND "TEXT" "C" CTT THTV ROT JARI)
        )
        (PROGN
         (SETQ ROT (ANGTOS ROT))
         (COMMAND "TEXT" "C" CT THTV ROT JARI)
      )))
      (PROGN
       (SETQ BRG (- 450 (* 180 (/ BRG PI))))
       (IF (<= 360 BRG)(SETQ BRG (- BRG 360)))
       (SETQ BR (FIX BRG) MS (* 60 (- BRG BR)) MN (FIX MS))
       (SETQ SE (* (FIX (+ (/ (* 60 (- MS MN)) 10) 0.5)) 10))
       (IF (< 55 SE) (PROGN (SETQ MN (+ 1 MN))(SETQ SE 0)))
       (IF (< 59 MN) (PROGN (SETQ BR (+ 1 BR))(SETQ MN 0)))
       (SETQ BR (ITOA BR) MN (ITOA MN) SE (ITOA SE))
       (IF (= 1 (STRLEN MN))(SETQ MN (STRCAT "0" MN)))
       (IF (= 1 (STRLEN SE))(SETQ SE (STRCAT "0" SE)))
       (SETQ BERING (STRCAT BR "%%D" MN (CHR 39) SE (CHR 34)))
       (SETQ BGT (* THT (STRLEN BERING)) JART (* THT (+ 2 (STRLEN JARI))) BR "L")
       (IF (< JARL BGT)
        (PROGN
         (IF (< PI ROT)
          (PROGN
           (SETQ CT (POLAR (POLAR BL ROT (- (/ JAR 2) (/ THT 4))) (+ ROT (* 0.5 PI)) THT))
           (SETQ CTJ (POLAR (POLAR BL ROT (+ (/ JAR 2) (* 1.25 THT))) (+ ROT (* 0.5 PI)) THT))
           (SETQ ROT (ANGTOS (+ ROT (* 0.5 PI))))
           (COMMAND "TEXT" CT THTV ROT BERING)
           (COMMAND "TEXT" CTJ THTV ROT JARI)
          )
          (PROGN
           (SETQ CT (POLAR (POLAR BL ROT (+ (/ THT 4) (/ JAR 2))) (+ ROT (* 0.5 PI)) THT))
           (SETQ CTJ (POLAR (POLAR BL ROT (- (/ JAR 2) (* 1.25 THT))) (+ ROT (* 0.5 PI)) THT))
           (SETQ ROT (ANGTOS (- ROT (* 0.5 PI))))
           (COMMAND "TEXT" "R" CT THTV ROT BERING)
           (COMMAND "TEXT" "R" CTJ THTV ROT JARI)
         ))
         (SETQ BR "S")
       ))
       (IF (= BR "L")
        (PROGN
        (SETQ CTB (POLAR (POLAR BL ROT (/ JAR 2)) (- ROT (* 0.5 PI)) (* 1.75 THT)))
        (SETQ CT (POLAR (POLAR BL ROT (/ JAR 2)) (+ ROT (* 0.5 PI)) (* 0.75 THT)))
        (SETQ CTC (POLAR (POLAR BL ROT (/ JAR 2)) (+ ROT (* 0.5 PI)) (* 1.75 THT)))
        (SETQ CTD (POLAR (POLAR BL ROT (/ JAR 2)) (- ROT (* 0.5 PI)) (* 0.75 THT)))
        (IF (> JARL (+ BGT JART))
         (PROGN
          (SETQ BERING (STRCAT BERING " " JARI))
          (IF (< (* 0.5 PI) ROT (* 1.5 PI))
           (PROGN
            (SETQ ROT (ANGTOS (- ROT PI)))
            (COMMAND "TEXT" "C" CTC THTV ROT BERING)
           )
           (PROGN
            (SETQ ROT (ANGTOS ROT))
            (COMMAND "TEXT" "C" CT THTV ROT BERING)
         )))
         (PROGN
          (IF (< (* 0.5 PI) ROT (* 1.5 PI))
           (PROGN
            (SETQ ROT (ANGTOS (- ROT PI)))
            (COMMAND "TEXT" "C" CTD THTV ROT JARI)
            (COMMAND "TEXT" "C" CTC THTV ROT BERING)
           )
           (PROGN
            (SETQ ROT (ANGTOS ROT))
            (COMMAND "TEXT" "C" CT THTV ROT BERING)
            (COMMAND "TEXT" "C" CTB THTV ROT JARI)
  ))))))))))
  (SETQ L (1+ L))
))
(TERPRI)
(SETVAR "CMDECHO" SCMDE))
(SETQ WS (READ-CHAR WSE))
(SETQ WS (READ-CHAR WSE))
(SETQ WS (READ-CHAR WSE))
(CLOSE WSE)
)

 

Now, a couple of things, I found a couple of random "U"s there, and deleted them.

 

Your balance of parenthesis was correct, but correct indenting just makes it easier to keep control of that area.

 

Get rid of that line as I posted earlier.

 

I can't understand the last 5 lines of code. They refer to reading a character on a line of text from a file called "WSE", or something, but you are not doing anything with them, and just assigning the next character to the same variable each time. Then you are closing a file, that you have not yet opened. I would suggest deleting those last 5 lines, maybe even the last 6 lines.

 

As I said, I haven't checked your code. Hope that helps for a start, then we can look at progressing further with your request.

jason tay Contributor

jason tay

Posted
  • Author
Posted

Dear Alan,

i delete the last last 5 lines of code and try to load the code but

this appear ; error: malformed list on input

what effect on it actually?

CarlB Proficient

CarlB

Posted
Posted

Don't delete the very last line - the ")", if you do it causes a parentheses imbalance and thus the error messages. Alan was referring to the lines just above that.

jason tay Contributor

jason tay

Posted
  • Author
Posted

CarlB,

as i try to print out and check but still cant fix it:oops: ,

:lol: is a long way for me to learn.

is that a good way to learn lisp form modify it as what i am try to do now?

jason tay Contributor

jason tay

Posted
  • Author
Posted

2.The Angle(Deg/Min/Sec) can be set for choice

-Round up (as existing )

-Not Round up

 

is that any one could help on this ?

thanks

  • 2 weeks later...
CarlB Proficient

CarlB

Posted
Posted

Try this routine. I did some formatting of the one you posted, deleted those lines Alan referred to regarding reading a file, added option to round or not. Let me know how it works.

Bearing-Distance.lsp

  • 1 year later...
SEGUL Apprentice

SEGUL

Posted
Posted

Hi CarlB

 

I would like to kindly ask if you could ammend the Bearing-Distance.lsp code you created so that the txt alignes to the line each bearing is at.

 

Your kind assitance will be appreciated......it would be a big help to me.....thanks

 

i look forward to your kind reply

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...