Topic: Pick a point in paperspace (within a viewport), return modelspace coords

[Eddie D.]

How could this be accomplished with lisp?

[gile]

Hi,

Here's a LISP I wrote some times ago.
It draws a leader with WCS coordinates of a point selected through a paper space viewport.

Code: [Select]

;; Coords
;; Creates a leader in the paper space which text is WCS coordinates of the selected point

(defun c:Coords (/ vp elst os pt1 pt2 pt)
  (vl-load-com)
  (or *acdoc*
      (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
  )
  (if (= (getvar "TILEMODE") 0)
    (progn
      (vla-put-MSpace *acdoc* :vlax-False)
      (and
(setq vp (car (entsel "\nSelect a viewport: ")))
(setq elst (entget vp))
(or (= (cdr (assoc 0 elst)) "VIEWPORT")
    (and (member (cdr (assoc 0 elst))
'("CIRCLE" "ELLIPSE" "LWPOLYLINE" "REGION" "SPLINE")
)
(setq vp (cdr (assoc 330 elst)))
(= (cdr (assoc 0 (entget vp))) "VIEWPORT")
    )
)
(setq vp (vlax-ename->vla-object vp))
(= (vla-get-ObjectName vp) "AcDbViewport")
(setq os (osmodes))
(while
  (and
    (setq pt1 (getpoint "\nFirst point of the leader: "))
    (setq pt1 (trans pt1 1 0))
    (not (vla-put-MSpace *acdoc* :vlax-true))
    (not (vla-put-activePViewport *acdoc* vp))
    (setq pt (osnap (trans (trans pt1 3 2) 2 1) os))
    (setq pt (trans pt 1 0))
    (not (vla-put-MSpace *acdoc* :vlax-False))
    (setq pt1 (trans pt1 0 1))
    (setq pt2 (getpoint pt1 "\nFollowing point: "))
  )
   (vl-cmdf "_.leader"
    "_non"
    pt1
    "_non"
    pt2
    ""
    (strcat
      (rtos (car pt))
      "  "
      (rtos (cadr pt))
      ;"  "
      ;(rtos (caddr pt))
    )
    ""
   )
)
(vla-put-MSpace *acdoc* :vlax-False)
      )
    )
    (princ
      "\nThis command is only available in layouts."
    )
  )
  (princ)
)


;; osmodes
;; Returns a strin of active osnaps

(defun osmodes (/ os str)
  (setq os  (getvar 'osmode)
str ""
  )
  (mapcar
    (function
      (lambda (m b)
(if (= b (logand b os))
  (setq str (strcat str m ","))
)
      )
    )
    '("_end" "_mid" "_cen" "_nod" "_qua" "_int" "_ins" "_nea")
    '(1 2 4 8 16 32 64 512)
  )
  str
)

[Eddie D.]

Thanks! That helped me "remember"  (trans).  That is the function I'm needing. I don't know why I overlooked it.

[gile]

You're welcome, and welcome at TheSwamp

I'm glad it helps

[VovKa]

i hope it will work for XY viewports

Code: [Select]

(defun test (/ SS EntProps MSPoint PSPoint)
  (princ "\nSelect viewport: ")
  (if (setq SS (ssget "_:S" (list (cons 0 "VIEWPORT"))))
    (while (setq PSPoint (getpoint "\nSpecify point: "))
      (setq EntProps (entget (ssname SS 0))
    MSPoint  (polar
       (cdr
(mapcar '+ (assoc 12 EntProps) (assoc 17 EntProps))
       )
       (angle (cdr (assoc 10 EntProps)) PSPoint)
       (/ (distance (cdr (assoc 10 EntProps)) PSPoint)
  (/ (cdr (assoc 41 EntProps))
     (cdr (assoc 45 EntProps))
  )
       )
     )
      )
      (entmake
(list
  (cons 0 "MTEXT")
  (cons 100 "AcDbEntity")
  (cons 100 "AcDbMText")
  (cons 1
(strcat (rtos (car MSPoint)) "\n" (rtos (cadr MSPoint)))
  )
  (cons 10 PSPoint)
  (cons 40 5.0)
  (cons 50 0.0)
  (cons 71 4)
)
      )
    )
  )
  (princ)
)


[mjguzik]

I couldn't attribute these two functions, but have had them for many years addressing conversion between MS and PS.

Code: [Select]

;;;*******************************************************************************************
;;; FUNCTION: PS->MS
;;; DESCRIPTION: Converts PS coordinate to MS
;;; ARGS: point
;;; EXAMPLE: (ps->ms '(2.87312 2.58077))
;;; RETURNS: (2.5 2.5)
;;;*******************************************************************************************
(defun ps->ms (point / x y) (mapcar 'set '(x y) (trans (trans (trans point 3 2) 2 1) 1 0)))


;;;*******************************************************************************************
;;; FUNCTION: MS->PS
;;; DESCRIPTION: Converts MS coordinate to PS
;;; ARGS: point
;;; EXAMPLE: (ms->ps '(2.5 2.5))
;;; RETURNS: (2.87312 2.58077)
;;;*******************************************************************************************
(defun ms->ps (point / x y) (mapcar 'set '(x y) (trans (trans (trans point 1 0) 0 2) 2 3)))




Hope it helps

MJG