Edit lisp: need Northing East from WUCS not current ucs

[Hammer.John.J]

thanks to alan thopmson for helping out with the original! However, what i need is for this to reference the world ucs coordinates while i am inserting these labels using a different ucs. It would also be really nice if a line could be placed from the end of the leader to the end of the last digit in the longest text line, i.e. the northing or easting depending on which is longer.

thanks!

;get id
;this routine gets the id of a point and places text (with or without a leader) at that pont
;created by: alan thompson (12.4.07)
;edited by: alan thopmson  (5.4.08)  updated just to work a little better, stopped using leader and uses qleader
;                     will also reset qleader settings to what the were before.
(DEFUN C:PID()
(setvar "cmdecho" 0)
(setq qsettings (ql-get))
(princ "\nNorthing & Easting Text Labeler")
(setq answer (strcase (getstring "\nLeader/No leader <Leader>: ")))
(cond     ((= answer "L")        (setq kopy 1))
        ((= answer "leader")    (setq kopy 1))
        ((= answer "")        (setq kopy 1))
        ((= answer "N")        (setq kopy 2))
        ((= answer "No")    (setq kopy 2))
        (t nil)
) ; End of Cond
(if (= kopy 1)
(progn
(WHILE
  (setq pt (getpoint "\nSelect point to identify: "))
  (setq pt2 (getpoint pt "\nSelect point for text placement: "))
  (setq ptascii-x (car pt))
  (setq ptascii-x (rtos ptascii-x))
  (setq ptascii-y (cadr pt))
  (setq ptascii-y (rtos ptascii-y))
  (setq ptascii-z (caddr pt))
  (setq ptascii-z (rtos ptascii-z))
  (setq textstr1 (strcat  "NORTHING: "  ptascii-y ))
  (setq textstr2 (strcat "EASTING: " ptascii-x ))
  (setq textsize-flag (getvar "TEXTSIZE"))
    (progn
    (ql-set '((3 . "") (40 . 0.0) (60 . 0) (61 . 0) (62 . 2) (63 . 2) (64 . 0) (65 . 0) (66 . 0) (67 . 3) (68 . 0) (69 . 0) (70 . 0) (71 . 0) (72 . 0) (170 . 0)))
    (command "qleader" pt pt2 "" textstr1 textstr2 "")
    (ql-set qsettings)
    );progn
) ; while
) ; End of Progn
) ; End of If
(if (= kopy 2)
(progn
(WHILE
  (setq pt (getpoint "\nSelect point to identify: "))
  (setq ptascii-x (car pt))
  (setq ptascii-x (rtos ptascii-x))
  (setq ptascii-y (cadr pt))
  (setq ptascii-y (rtos ptascii-y))
  (setq ptascii-z (caddr pt))
  (setq ptascii-z (rtos ptascii-z))
  (setq textstr1 (strcat  "NORTHING: "  ptascii-y ))
  (setq textstr2 (strcat "EASTING: " ptascii-x ))
  (setq textsize-flag (getvar "TEXTSIZE"))
  (command "mtext" pt "w" "0" textstr1 textstr2 "")
) ; while
) ; End of Progn
) ; End of If
(princ))


(DEFUN QL-GET (/ XR COD ITM REPLY)
  (IF (SETQ XR (DICTSEARCH (NAMEDOBJDICT) "AcadDim"))
    (PROGN
      (FOREACH COD
           '(3 40 60 61 62 63 64 65 66 67 68 69 70 71 72 170 340)
    (IF (SETQ ITM (ASSOC COD XR))
      (SETQ REPLY (APPEND REPLY (LIST ITM)))
    )
      )
      REPLY
    )
    '((3 . "")
      (40 . 0.0)
      (60 . 0)
      (61 . 0)
      (62 . 1)
      (63 . 1)
      (64 . 0)
      (65 . 1)
      (66 . 0)
      (67 . 3)
      (68 . 0)
      (69 . 0)
      (70 . 0)
      (71 . 0)
      (72 . 0)
      (170 . 0)
     )
  )
)

(DEFUN QL-SET (ARG / CUR PRM)
  (SETQ CUR (QL-GET))
  (WHILE ARG
    (SETQ PRM (CAR ARG)
      ARG (CDR ARG)
      CUR (SUBST PRM (ASSOC (CAR PRM) CUR) CUR)
    )
    (IF    (= 3 (CAR PRM))
      (SETVAR "DIMLDRBLK" (CDR PRM))
    )
  )
  (DICTREMOVE (NAMEDOBJDICT) "AcadDim")
  (SETQ
    CUR    (APPEND    '((0 . "XRECORD") (100 . "AcDbXrecord") (90 . 990106))
        CUR
    )
  )
  (DICTADD (NAMEDOBJDICT) "ACADDIM" (ENTMAKEX CUR))
  (QL-GET)
)

[rkmcswain]

...what i need is for this to reference the world ucs coordinates while i am inserting these labels using a different ucs.

Take the coordinates returned by the (getpoint) function and use the (trans) function to translate them back to WCS.

[Hammer.John.J]

hmmm, well that sounds like a good answer I'm not the programmer cad 'type'. How would these functions understand that i may have 5 different UCS' I am working with and to always reference the WUCS.

Basically, we want the coords from WUCS but to draft them ortho in the current UCS which just happens to be some sort of rotation and different origin point relative to WUCS.

basically, i can't program it.


Thanks for the info RK, maybe someone can help me land that in the lisp.

[rkmcswain]

The (trans) function can convert coordinates from one coordinate system to another.

(trans pt 1 0) will convert pt from the current ucs to WCS.

Replace this section of code and test.

(setq pt (getpoint "\nSelect point to identify: "))
  (setq ptwcs (trans pt 1 0))
  (setq pt2 (getpoint pt "\nSelect point for text placement: "))
  (setq ptascii-x (car ptwcs))
  (setq ptascii-x (rtos ptascii-x))
  (setq ptascii-y (cadr ptwcs))
  (setq ptascii-y (rtos ptascii-y))
  (setq ptascii-z (caddr ptwcs))
  (setq ptascii-z (rtos ptascii-z))

[Hammer.John.J]

awesome!!

now what do you think about getting a line centered between those 2 pieces of text