Author Topic: Label Coordinate  (Read 1288 times)

0 Members and 1 Guest are viewing this topic.

mohan

  • Newt
  • Posts: 98
Label Coordinate
« on: July 05, 2021, 04:41:56 AM »
Help to correction this route ! :?
Code: [Select]
; coord-ldr.lsp
; x,y Coordinates on Leader Lines
(defun C:CR (/ *error* PNT1 P1X P1Y STDY DY COORD PTXT)
 
(defun *error* ( msg )
(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred")))
  (princ));end_defun
 
  (setvar 'TEXTSTYLE RomanS)
  (setvar 'TEXTSIZE 3.5)
    (setq PNT1 (getpoint "\nPick coordinate point: "))
    (setq P1X (car pnt1))  ;x coord
    (setq P1Y (cadr pnt1)) ;y coord
    (setq STDX (rtos P1X 2 3))
    (setq STDY (rtos P1Y 2 3))
    (setq COORD (strcat "Off- "  STDX)
          COORD1(strcat "Elev- " STDY))
    (setq PTXT (getpoint PNT1 "\nPick text location: "))
(Progn 
 (command "_-style" "RomanS" "RomanS.shx" "0.000" "1" "0" "n" "n" "n")
 (command "LEADER" PNT1 PTXT "" COORD COORD1 "" "")) (princ))
(ALERT "IT WILL PRINT THE X,Y CO-ORDINATES OF A POINT..., C:Cc")
"Save Energy"

BIGAL

  • Swamp Rat
  • Posts: 1398
  • 40 + years of using Autocad
Re: Label Coordinate
« Reply #1 on: July 07, 2021, 12:38:25 AM »
Try this

Code: [Select]
(defun C:CR (/ *error* PNT1 P1X P1Y STDY DY COORD PTXT)
 
(defun *error* ( msg )
(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred")))
  (princ));end_defun
 
 (setq ts (tblsearch "Style" "Romans"))
 (if (= ts nil)(command "_-style" "RomanS" "RomanS.shx" "0.000" "1" "0" "n" "n" "n"))
 
  (setvar 'TEXTSTYLE "RomanS")
  (setvar 'TEXTSIZE 3.5)
    (setq PNT1 (getpoint "\nPick coordinate point: "))
    (setq P1X (car pnt1))  ;x coord
    (setq P1Y (cadr pnt1)) ;y coord
    (setq STDX (rtos P1X 2 3))
    (setq STDY (rtos P1Y 2 3))
    (setq COORD (strcat "Off- "  STDX)
          COORD1(strcat "Elev- " STDY))
    (setq PTXT (getpoint PNT1 "\nPick text location: "))

 
 (command "LEADER" PNT1 PTXT "" COORD COORD1 "" "")
 
 (princ)
 )
(ALERT "IT WILL PRINT THE X,Y CO-ORDINATES OF A POINT..., C:Cc")
A man who never made a mistake never made anything

mohan

  • Newt
  • Posts: 98
Re: Label Coordinate
« Reply #2 on: July 08, 2021, 05:06:30 AM »
Text size & style not changing !
Text size to 3.5
Text style to RomanS, by the way leader size also need to change to 3.5
"Save Energy"

ScottMC

  • Newt
  • Posts: 191
Re: Label Coordinate
« Reply #3 on: November 15, 2021, 10:29:24 PM »
 Reworked..

Code: [Select]
                             ; coord-ldr.lsp
                      ; x,y Coordinates on Leader Lines
;;  http://www.theswamp.org/index.php?topic=56860.0

(defun c:idd (/ *error* ttsty PNT1 P1X P1Y STDY DY COORD PTXT)
   (princ "\n Coordinate Labeler <Textsize = \"2.0\"..")
   (setvar 'cmdecho 0)

   (setq ttsty (getvar 'textstyle))
   (setvar 'textstyle "Standard")

   (defun *error* (msg)
      (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*"))
         (princ (strcat "\nOops an Error : " msg " occurred"))
      ) ;_ end of if
      (princ)
   )                                              ;end_defun

   (setq PNT1 (getpoint "\nPick Coordinate Point: "))
   (setq P1X (car pnt1))                          ;x coord
   (setq P1Y (cadr pnt1))                         ;y coord
   (setq STDX (rtos P1X 2 3))
   (setq STDY (rtos P1Y 2 3))
   (setq COORD  (strcat "X_ " STDX)
         COORD1 (strcat "Y_ " STDY)
   ) ;_ end of setq
   (setq PTXT (getpoint PNT1 "\nPick Text Location: "))
   (progn
      (command "_-style" "Standard" "" 2.0 "1" "0" "" "")
      (command "LEADER" PNT1 PTXT "" COORD COORD1 "")
      (princ)
   ) ;_ end of progn
   (command)
   
   (setvar 'textstyle ttsty)
   (setvar 'cmdecho 1)
   (princ)
) ;_ end of defun

« Last Edit: November 16, 2021, 10:44:12 AM by ScottMC »