Jump to content

OS tile references

Baber62

By Baber62
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Baber62 Collaborator

Baber62

Posted
Posted

A colleague of mine forwarded me a lisp routine which determines the OS TQ tile reference, however, the tile reference is displayed in the command bar. Is there a way that the reference can be printed on the screen in model space.

 

The coding provided is as below:

 


;*** TQMAP
; prog to work which tq square is req
; the path to the tq 
sqs is in the prog
;if location of maps changes then this line has to change 
@
;***


(defun C:TQ ()
(command "setvar" "insunits" "0")
(command "setvar" 
"insunitsdefsource" "0")
(command "setvar" "insunitsdeftarget" 
"0")
(graphscr)
(command "expert" "5")
(command "ucs" "save" "UCS1" 
)
(command "ucs" "w" )   
(setq P1 (getpoint "Pick suitable 
point "))    ;co ord
(setq PEAST (car 
P1))       ;eastings
(setq PNORTH (cadr 
P1))       ;northings
(setq PEASTF (rtos 
PEAST 2 0))      ;conversion to string
(setq 
PNORTHF (rtos PNORTH 2 0))     

(setq 
TQEAST (substr PEASTF 2 2))     ;parts of 
coords
(setq TQNORTH (substr PNORTHF 2 2))
(setq TQSQ (strcat TQEAST 
TQNORTH))     ;name of map
(setq TQEASTSQ (atoi 
(substr PEASTF 4 2)))
(setq TQNORTHSQ (atoi (substr PNORTHF 4 2)))



 (if (and (<= TQEASTSQ 50)(<= TQNORTHSQ 50))
 (setq 
MAP "SW")
 )


 (if (and (<= TQEASTSQ 50)(> TQNORTHSQ 50))
 (setq MAP 
"NW")
 )


 (if (and (> TQEASTSQ 50)(<= TQNORTHSQ 50))
 (setq MAP 
"SE")
 )


 (if (and (> TQEASTSQ 50)(> TQNORTHSQ 50))
 (setq MAP 
"NE")
 )


      ;
(setq REPLY (strcat 
"Co-ordinates give TQ" TQSQ MAP))   
(princ REPLY)
(print)





(setq MPATH 
"//Regensw2k-svr01/basemaps/1250/")    ;@  path for os 
maps
(setq DPATH (strcat MPATH "TQ" TQSQ MAP))


(command "-layer" "make" "xrefs" "")
(command "-xref" "O" DPATH "0,0" "" 
"" "")
(command "ucs" "restore" "UCS1" )
(command "-LAYER" "F" 
"*B_PT,*E_BY,*T_BY,*BMER,*G_PT,*PL_B,*GRID,*HTPT,*R_CL" "C" "252" "*tq*" "C" 
"251" "*road" "C" "250" "*buildout,buildpk" "")
(command "-LAYER" "F" 
"*8010010,*8010098,*8010321,*8010570,*8010571,*8010572,*8010573,*8010574,*8010575" 
"C" "252" "*G80*" "C" "251" "*8010021" "C" "250" "*8010001" "" )
)



;*** TQMAP
; prog to work which tq square is req
; the path to the 
tq sqs is in the prog
;if location of maps changes then this line has to 
change @
;***


(defun C:TQL ()
(command "setvar" "insunits" "0")
(command "setvar" 
"insunitsdefsource" "0")
(command "setvar" "insunitsdeftarget" 
"0")
(graphscr)
(command "expert" "5")
(command "ucs" "save" "UCS1" 
)
(command "ucs" "w" )    
(setq P1 (getpoint "Pick 
suitable point "))    ;co ord
(setq PEAST (car 
P1))       ;eastings
(setq PNORTH (cadr 
P1))       ;northings
(setq PEASTF (rtos 
PEAST 2 0))      ;conversion to string
(setq 
PNORTHF (rtos PNORTH 2 0))     

(setq 
TQEAST (substr PEASTF 2 2))     ;parts of 
coords
(setq TQNORTH (substr PNORTHF 2 2))
(setq TQSQ (strcat TQEAST 
TQNORTH))     ;name of map
(setq TQEASTSQ (atoi 
(substr PEASTF 4 2)))
(setq TQNORTHSQ (atoi (substr PNORTHF 4 2)))



 (if (and (<= TQEASTSQ 50)(<= TQNORTHSQ 50))
 (setq 
MAP "SW")
 )


 (if (and (<= TQEASTSQ 50)(> TQNORTHSQ 50))
 (setq MAP 
"NW")
 )


 (if (and (> TQEASTSQ 50)(<= TQNORTHSQ 50))
 (setq MAP 
"SE")
 )


 (if (and (> TQEASTSQ 50)(> TQNORTHSQ 50))
 (setq MAP 
"NE")
 )


      ;
(setq REPLY (strcat 
"Co-ordinates give TQ" TQSQ MAP))
(princ REPLY)
(print)


(setq MPATH 
"P:/CGG/CAD/Data/Mapping/LBI/TQ-May2005/")    ;@  path 
for os maps
(setq DPATH (strcat MPATH "TQ" TQSQ MAP))


(command "-layer" "make" "xrefs" "")
(command "-xref" "O" DPATH "0,0" "" 
"" "")
(command "ucs" "restore" "UCS1" )
(command "-LAYER" "F" 
"*B_PT,*E_BY,*T_BY,*BMER,*G_PT,*PL_B,*GRID,*HTPT,*R_CL" "C" "252" "*tq*" "C" 
"251" "*road" "C" "250" "*buildout,buildpk" "")
(command "-LAYER" "F" 
"*8010010,*8010098,*8010321,*8010570,*8010571,*8010572,*8010573,*8010574,*8010575" 
"C" "252" "*G80*" "C" "251" "*8010021" "C" "250" "*8010001" "" )


(command "expert" "0")


)



;*** TQMAP
; prog to work which tq square is req
; the path to the 
tq sqs is in the prog
;if location of maps changes then this line has to 
change @
;***


(defun C:TQQl ()
(command "setvar" "insunits" "0")
(command "setvar" 
"insunitsdefsource" "0")
(command "setvar" "insunitsdeftarget" 
"0")
(graphscr)
(COMMAND "UCS" "W")
(SETQ TQ (getstring "\n TQ NUMBER ? 
"))     ;eastings
    



(setq MPATH 
"P:/CGG/CAD/Data/Mapping/LBI/TQ-May2005/")    ;@  path 
for os maps
(setq DPATH (strcat MPATH TQ))


(command "-layer" "make" "xrefs" "")
(command "-xref" "O" DPATH "0,0" "" 
"" "")
(COMMAND "UCS" "P") 


)



;*** TQMAP
; prog to work which tq square is req
; the path to the 
tq sqs is in the prog
;if location of maps changes then this line has to 
change @
;***


(defun C:TQQ ()
(command "setvar" "insunits" "0")
(command "setvar" 
"insunitsdefsource" "0")
(command "setvar" "insunitsdeftarget" 
"0")
(graphscr)
(COMMAND "UCS" "W")
(SETQ TQ (getstring "\n TQ NUMBER ? 
"))     ;eastings
 
(setq MPATH 
"P:/CGG/CAD/Resources/OS-Data/")    ;@  path for os 
maps
(setq DPATH (strcat MPATH TQ))


(command "-layer" "make" "xrefs" "")
(command "-xref" "O" DPATH "0,0" "" 
"" "")
(COMMAND "UCS" "P")
(command "-LAYER" "F" 
"*B_PT,*E_BY,*T_BY,*BMER,*G_PT,*PL_B,*GRID,*HTPT,*R_CL" "C" "253" "*tq*" "C" 
"252" "*road" "")
(command "-LAYER" "F" 
"*8010010,*8010098,*8010321,*8010570,*8010571,*8010572,*8010573,*8010574,*8010575" 
"C" "253" "*G80*" "C" "251" "*8010021" "")
)

 

 

Thanks for your assist in advance guys.

Least Enthusiast

Least

Posted
Posted

Hows is this?

;;;http://www.cadtutor.net/forum/showthread.php?94664-OS-tile-references

;*** TQMAP
; prog to work which tq square is req
; the path to the tq 
sqs is in the prog
;if location of maps changes then this line has to change 
@
;***


(defun C:TQ ()
(command "setvar" "insunits" "0")
(command "setvar" 
"insunitsdefsource" "0")
(command "setvar" "insunitsdeftarget" 
"0")
(graphscr)
(command "expert" "5")
(command "ucs" "save" "UCS1" 
)
(command "ucs" "w" )   
(setq P1 (getpoint "Pick suitable 
point "))    ;co ord
(setq PEAST (car 
P1))       ;eastings
(setq PNORTH (cadr 
P1))       ;northings
(setq PEASTF (rtos 
PEAST 2 0))      ;conversion to string
(setq 
PNORTHF (rtos PNORTH 2 0))     

(setq 
TQEAST (substr PEASTF 2 2))     ;parts of 
coords
(setq TQNORTH (substr PNORTHF 2 2))
(setq TQSQ (strcat TQEAST 
TQNORTH))     ;name of map
(setq TQEASTSQ (atoi 
(substr PEASTF 4 2)))
(setq TQNORTHSQ (atoi (substr PNORTHF 4 2)))



 (if (and (<= TQEASTSQ 50)(<= TQNORTHSQ 50))
 (setq 
MAP "SW")
 )


 (if (and (<= TQEASTSQ 50)(> TQNORTHSQ 50))
 (setq MAP 
"NW")
 )


 (if (and (> TQEASTSQ 50)(<= TQNORTHSQ 50))
 (setq MAP 
"SE")
 )


 (if (and (> TQEASTSQ 50)(> TQNORTHSQ 50))
 (setq MAP 
"NE")
 )


      ;
(setq REPLY (strcat 
"Co-ordinates give TQ" TQSQ MAP))   
(princ REPLY)
(print)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  PB - Metrix 2015

(SETQ DFLT 0)
(SETQ TXTHG (GETVAR "textsize"))
(PRINC "\nText Height: <")
(PRIN1 TXTHG)
(PRINC ">: ")
(SETQ THGT (GETDIST))
(IF (= THGT nil)
(SETQ THGT TXTHG)
)



; (SETQ PTXT (GETPOINT "\nLocate Text: "))

(setq old_layer (getvar "clayer")); Get current Layer

(SETVAR "cmdecho" 0)

;(setq PTXT (getvar "viewctr"))

(COMMAND "layer" "se" "text" "")

(COMMAND "text" P1 THGT "" REPLY)
(command "move" "last" "" PTXT pause)

(command "_layer" "S" old_layer ""); reset Layer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 



(setq MPATH 
"//Regensw2k-svr01/basemaps/1250/")    ;@  path for os 
maps
(setq DPATH (strcat MPATH "TQ" TQSQ MAP))


(command "-layer" "make" "xrefs" "")
(command "-xref" "O" DPATH "0,0" "" 
"" "")
(command "ucs" "restore" "UCS1" )
(command "-LAYER" "F" 
"*B_PT,*E_BY,*T_BY,*BMER,*G_PT,*PL_B,*GRID,*HTPT,*R_CL" "C" "252" "*tq*" "C" 
"251" "*road" "C" "250" "*buildout,buildpk" "")
(command "-LAYER" "F" 
"*8010010,*8010098,*8010321,*8010570,*8010571,*8010572,*8010573,*8010574,*8010575" 
"C" "252" "*G80*" "C" "251" "*8010021" "C" "250" "*8010001" "" )
)



;*** TQMAP
; prog to work which tq square is req
; the path to the 
tq sqs is in the prog
;if location of maps changes then this line has to 
change @
;***


(defun C:TQL ()
(command "setvar" "insunits" "0")
(command "setvar" 
"insunitsdefsource" "0")
(command "setvar" "insunitsdeftarget" 
"0")
(graphscr)
(command "expert" "5")
(command "ucs" "save" "UCS1" 
)
(command "ucs" "w" )    
(setq P1 (getpoint "Pick 
suitable point "))    ;co ord
(setq PEAST (car 
P1))       ;eastings
(setq PNORTH (cadr 
P1))       ;northings
(setq PEASTF (rtos 
PEAST 2 0))      ;conversion to string
(setq 
PNORTHF (rtos PNORTH 2 0))     

(setq 
TQEAST (substr PEASTF 2 2))     ;parts of 
coords
(setq TQNORTH (substr PNORTHF 2 2))
(setq TQSQ (strcat TQEAST 
TQNORTH))     ;name of map
(setq TQEASTSQ (atoi 
(substr PEASTF 4 2)))
(setq TQNORTHSQ (atoi (substr PNORTHF 4 2)))



 (if (and (<= TQEASTSQ 50)(<= TQNORTHSQ 50))
 (setq 
MAP "SW")
 )


 (if (and (<= TQEASTSQ 50)(> TQNORTHSQ 50))
 (setq MAP 
"NW")
 )


 (if (and (> TQEASTSQ 50)(<= TQNORTHSQ 50))
 (setq MAP 
"SE")
 )


 (if (and (> TQEASTSQ 50)(> TQNORTHSQ 50))
 (setq MAP 
"NE")
 )


      ;
(setq REPLY (strcat 
"Co-ordinates give TQ" TQSQ MAP))
(princ REPLY)
(print)


(setq MPATH 
"P:/CGG/CAD/Data/Mapping/LBI/TQ-May2005/")    ;@  path 
for os maps
(setq DPATH (strcat MPATH "TQ" TQSQ MAP))


(command "-layer" "make" "xrefs" "")
(command "-xref" "O" DPATH "0,0" "" 
"" "")
(command "ucs" "restore" "UCS1" )
(command "-LAYER" "F" 
"*B_PT,*E_BY,*T_BY,*BMER,*G_PT,*PL_B,*GRID,*HTPT,*R_CL" "C" "252" "*tq*" "C" 
"251" "*road" "C" "250" "*buildout,buildpk" "")
(command "-LAYER" "F" 
"*8010010,*8010098,*8010321,*8010570,*8010571,*8010572,*8010573,*8010574,*8010575" 
"C" "252" "*G80*" "C" "251" "*8010021" "C" "250" "*8010001" "" )


(command "expert" "0")


)



;*** TQMAP
; prog to work which tq square is req
; the path to the 
tq sqs is in the prog
;if location of maps changes then this line has to 
change @
;***


(defun C:TQQl ()
(command "setvar" "insunits" "0")
(command "setvar" 
"insunitsdefsource" "0")
(command "setvar" "insunitsdeftarget" 
"0")
(graphscr)
(COMMAND "UCS" "W")
(SETQ TQ (getstring "\n TQ NUMBER ? 
"))     ;eastings
    



(setq MPATH 
"P:/CGG/CAD/Data/Mapping/LBI/TQ-May2005/")    ;@  path 
for os maps
(setq DPATH (strcat MPATH TQ))


(command "-layer" "make" "xrefs" "")
(command "-xref" "O" DPATH "0,0" "" 
"" "")
(COMMAND "UCS" "P") 


)



;*** TQMAP
; prog to work which tq square is req
; the path to the 
tq sqs is in the prog
;if location of maps changes then this line has to 
change @
;***


(defun C:TQQ ()
(command "setvar" "insunits" "0")
(command "setvar" 
"insunitsdefsource" "0")
(command "setvar" "insunitsdeftarget" 
"0")
(graphscr)
(COMMAND "UCS" "W")
(SETQ TQ (getstring "\n TQ NUMBER ? 
"))     ;eastings
 
(setq MPATH 
"P:/CGG/CAD/Resources/OS-Data/")    ;@  path for os 
maps
(setq DPATH (strcat MPATH TQ))


(command "-layer" "make" "xrefs" "")
(command "-xref" "O" DPATH "0,0" "" 
"" "")
(COMMAND "UCS" "P")
(command "-LAYER" "F" 
"*B_PT,*E_BY,*T_BY,*BMER,*G_PT,*PL_B,*GRID,*HTPT,*R_CL" "C" "253" "*tq*" "C" 
"252" "*road" "")
(command "-LAYER" "F" 
"*8010010,*8010098,*8010321,*8010570,*8010571,*8010572,*8010573,*8010574,*8010575" 
"C" "253" "*G80*" "C" "251" "*8010021" "")
)

Least Enthusiast

Least

Posted
Posted

Do you have a lisp that does any off the other tiles?

P

Baber62 Collaborator

Baber62

Posted
  • Author
Posted

Hi Least,

 

It does the trick fine, however, just one slight modification need an arrow to point to the location clicked. Can the text be multi-line text with arial font?

 

thanks

Baber62 Collaborator

Baber62

Posted
  • Author
Posted

I don't have access at the current to any other tiles than the TQ tiles, however, when I get home this evening I should have access to other tiles up and down the UK and I will give it a go and let you know of the results.

Least Enthusiast

Least

Posted
Posted

The only way I could get that to work is to make an attributed block and insert it at 'P1' with the attribute containing the variable 'REPLY'.

 

Maybe somebody a little bit more clued up will come along, I'm a little bit up to my ears right now.

 

P

Baber62 Collaborator

Baber62

Posted
  • Author
Posted

Hi Least,

 

Tried it with these co-ordinates 548237,099194, this is a location down south near the coast in Seaford. It put up on screen co-ordinates give TQ4891NW, whereas using the UK grid finder it gives "TV 48237 99194" so the TQ change in value to TV. Therefore this lisp while it ok for say the London area it doesn't cover the whole of the UK. I will try and get hold of the corner co-ordinates for each of the TQ or TV or T? tiles and take it from there.

 

Thanks for your assist.

eldon Grand Master

eldon

Posted
Posted

You are using the lisp programme outside its quoted parameters. It is titled for TQ tiles only, so you should not expect it to give you a TV tile :cry:

 

If you look into the workings, it expects a Northing of six significant figures, and your example only had five significant figures (the leading zero is not a significant figure), so no wonder it is giving unexpected results.

 

The OS has quite a good tile finder on line

Tilenumbering.PNG

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...