Topic: Select object through a viewport

[Chris]

I have a lisp routine that I wrote (with the help of others) that will place the length of an object as a text object at the midpoint of a line.  I'd like to expand this program to be able to place a piece of text, in paperspace, by selecting the object visible in a viewport.  Any idea how to select the object through a viewport?

Please forgive the code, I'm sure it can be cleaned up quite a bit.

Code: [Select]

(defun c:lengthtext (/     lengthmode object
objchk     listobj vlobj
MidPoint    Param startpline
endpline    vlobjlen1 angle1
Ang     TH vlobjang
textobj1    textobj2 vlobjang1
vlobjang2   lengthscale lyrobj
vlobjlen    errmsg
)
      (if (not (tblsearch "Layer" "Annotation"))
(if (setq lyrobj (MakeLayer "Annotation" acadDocument))
 (progn
   (vla-put-color lyrobj acgreen)
   (vla-put-plottable lyrobj :vlax-true)
   (vlax-release-object lyrobj)
 ) ;_ end of progn
 (setq errmsg "\nLayer Make failed for Annotation layer")
) ;_ end of if
      ) ;_ end of if

      (setq lengthmode
(getint
 "\nSpecify Mode (1 = One Decimal, 2 = Two Decimals, 3 = Two Decimals with Bearing"
) ;_ end of getint
   lengthscale (atoi (vl-string-left-trim
":"
(vl-string-left-trim
 "1234567890"
 (getvar "cannoscale")
) ;_ end of vl-string-left-trim
     ) ;_ end of vl-string-left-trim
) ;_ end of atoi
      ) ;_ end of setq
      (if (= lengthmode 3)
(setq
 object
  (ssget
    (list
      (cons 0
    "ARC,LINE"
      ) ;_ end of cons
    ) ;_ end of list
  ) ;_ end of ssget
) ;_ end of setq
(setq
 object
  (ssget
    (list
      (cons 0
    "POLYLINE,*CONTOUR,ARC,LINE,LWPOLYLINE,2DPOLYLINE"
      ) ;_ end of cons
    ) ;_ end of list
  ) ;_ end of ssget
) ;_ end of setq
      ) ;_ end of if
      (while (setq listobj (ssname object 0))
(setq vlobj (vlax-ename->vla-object listobj))
(if (/= (cdr (assoc 0 (entget listobj))) "ARC")
 (setq vlobjlen1 (vla-get-length vlobj)
objchk  1
 ) ;_ end of setq
 (setq vlobjlen1 (vla-get-arclength vlobj)
objchk  2
 ) ;_ end of setq
) ;_ end of if
(setq MidPoint (vlax-curve-getpointatdist
  vlObj
  (/ vlobjlen1 2)
) ;_ end of vlax-curve-getpointatdist
     Param (vlax-curve-getParamAtPoint VlObj MidPoint)
     startpline (vlax-curve-getStartParam VlObj)
     endpline (vlax-curve-getEndParam VlObj)
     angle1 (vlax-curve-getFirstDeriv
  VlObj
  (/ (- endpline startpline) 2)
) ;_ end of vlax-curve-getFirstDeriv
     TH (* 0.08 lengthscale)
) ;_ end of setq
(if (= objchk 1)
 (progn
   (if (equal (car angle1) 0.0 0.01)
     (setq Ang (/ pi 2))
     (setq Ang (atan (/ (cadr angle1) (car angle1))))
   ) ;_ end of if
   (setq
     vlobjang (angtos Ang 4 3)
     vlobjang1 (vl-string-left-trim "NS 0123456789" vlobjang)
     vlobjang2 (vl-string-right-trim
 "EW \"0123456789'"
 vlobjang
) ;_ end of vl-string-right-trim
     vlobjang2 (vl-string-right-trim "d" vlobjang2)
     vlobjang (strcat vlobjang2 "%%" vlobjang1)
   ) ;_ end of setq
 ) ;_ end of progn
 (setq
   Ang      (- (/ (+ (vla-get-endangle vlobj)
      (vla-get-startangle vlobj)
   ) ;_ end of +
   2
) ;_ end of /
(/ pi 2)
     ) ;_ end of -
   vlobjang  (angtos Ang 4 3)
   vlobjang1 (vl-string-left-trim "NS 0123456789" vlobjang)
   vlobjang2 (vl-string-right-trim "EW \"0123456789'" vlobjang)
   vlobjang2 (vl-string-right-trim "d" vlobjang2)
   vlobjang  (strcat vlobjang2 "%%" vlobjang1)
 ) ;_ end of setq
) ;_ end of if
(cond
 ((= lengthmode 1)
  (if (wcmatch (rtos vlobjlen1 2 1) "*`.*")
    (setq vlobjlen (strcat (rtos vlobjlen1 2 1) "'"))
    (setq vlobjlen (strcat (rtos vlobjlen1 2 1) ".0'"))
  ) ;_ end of if
  (setq textObj1 (vla-addtext
   acadModelSpace
   vlobjlen
   (vlax-3d-point Midpoint)
   TH
 ) ;end vla-addtext
  ) ;end setq
 )
 ((= lengthmode 2)
  (cond
    ((wcmatch (rtos vlobjlen1 2 2) "*`.##")
     (setq vlobjlen (strcat (rtos vlobjlen1 2 2) "'")
     ) ;_ end of setq
    )
    ((wcmatch (rtos vlobjlen1 2 2) "*`.#")
     (setq vlobjlen (strcat (rtos vlobjlen1 2 2) "0'")
     ) ;_ end of setq
    )
    ((wcmatch (rtos vlobjlen1 2 2) "*")
     (setq vlobjlen (strcat (rtos vlobjlen1 2 2) ".00'")
     ) ;_ end of setq
    )
  ) ;_ end of cond
  (setq
    textObj1 (vla-addtext
acadModelSpace
vlobjlen
(vlax-3d-point Midpoint)
TH
     ) ;end vla-addtext
  ) ;end setq
 )
 ((= lengthmode 3)
  (cond
    ((wcmatch (rtos vlobjlen1 2 2) "*`.##")
     (setq vlobjlen (strcat (rtos vlobjlen1 2 2) "'")
     ) ;_ end of setq
    )
    ((wcmatch (rtos vlobjlen1 2 2) "*`.#")
     (setq vlobjlen (strcat (rtos vlobjlen1 2 2) "0'")
     ) ;_ end of setq
    )
    ((wcmatch (rtos vlobjlen1 2 2) "*")
     (setq vlobjlen (strcat (rtos vlobjlen1 2 2) ".00'")
     ) ;_ end of setq
    )
  ) ;_ end of cond
  (setq
    textObj1 (vla-addtext
acadModelSpace
vlobjlen
(vlax-3d-point Midpoint)
TH
     ) ;end vla-addtext
    textobj2 (vla-addtext
acadModelSpace
vlobjang
(vlax-3d-point Midpoint)
TH
     ) ;_ end of vla-addtext
  ) ;end setq
 )
) ;_ end of cond
(vla-put-color textobj1 256) ;change color
(vla-put-alignment textobj1 13) ;change justification
(vla-put-textalignmentpoint
 textobj1
 (vlax-3d-point Midpoint)
) ;_ end of vla-put-textalignmentpoint
;change insetion point
(vla-put-rotation textobj1 Ang)
;change rotation
(vla-put-layer textobj1 "Annotation")
(if (/= textObj2 nil)
 (progn
   (vla-put-color textobj2 256)
   (vla-put-alignment textobj2 13)
   (vla-put-textalignmentpoint
     textobj2
     (vlax-3d-point
(list
 (+ (car Midpoint) (* (sin ang) (* 0.16 lengthscale)))
 (- (cadr Midpoint) (* (cos ang) (* 0.16 lengthscale)))
 (caddr Midpoint)
) ;_ end of list
     ) ;_ end of vlax-3d-point
   ) ;_ end of vla-put-textalignmentpoint
   (vla-put-rotation textobj2 Ang)
   (vla-put-layer textobj2 "Annotation")
 ) ;_ end of progn
) ;_ end of if
(ssdel listobj object)
      ) ;end while
    ) ;end defun


[Lee Mac]

Hi Chris,

I think you are missing some code as variables such as 'acadModelSpace' are not referenced, but to achieve your result you just need to change the 'acadModelSpace' to a variable which accounts for what space you are working in.

Many examples, here are two:

Code: [Select]

(setq ActiveSpace
  (if
    (or
      (eq AcModelSpace
        (vla-get-ActiveSpace
          (setq doc
            (vla-get-ActiveDocument
              (vlax-get-acad-object)
            )
          )
        )
      )
      (eq :vlax-true (vla-get-MSpace doc))
    )
    (vla-get-ModelSpace doc)
    (vla-get-PaperSpace doc)
  )
)

Code: [Select]

(setq ActiveSpace
  (vlax-get-property
    (vla-get-ActiveDocument
      (vlax-get-acad-object)
    )
    (if (= 1 (getvar 'CVPORT))
      'PaperSpace
      'ModelSpace
    )
  )
)
So you would put such code next to where you are defining your other variables and replace acadModelSpace with ActiveSpace say.

Lee

[Chris]

This would work if I am in paperspace, clicking on an object that I am seeing in a viewport (sorry its the end of the day on Friday, I'm a little dense)

[Chris]

ok after going out, and coming back again, I understand what you were referring to.  That little code change will allow the text to be placed in paperspace or modelspace, depending on where I am.  That little snippet of code will help me out on a lot of things, Thanks!

here is the code my previous code was missing, it is place in our master lisp routine file to define these as global variables for all our customizations.

Code: [Select]

(vl-load-com)

    (setq acadObject      (vlax-get-acad-object)
          acadDocument    (vla-get-ActiveDocument acadObject)
          DwgProps        (vla-get-SummaryInfo acadDocument)
          acadModelSpace  (vla-get-modelspace acadDocument)
          acadPaperSpace  (vla-get-paperspace acadDocument)
          acadpreferences (vla-get-preferences acadobject)
          acadversion     (getvar "acadver")
          ccadversion     (atoi (vl-string-right-trim " (en)" (vl-string-left-trim "Visual LISP " (ver))))
          ActiveSpace     (if (or (eq AcModelSpace (vla-get-ActiveSpace acaddocument))
                                  (eq :vlax-true (vla-get-MSpace acaddocument))
                              ) ;_ end of or
                            (vla-get-ModelSpace acaddocument)
                            (vla-get-PaperSpace acaddocument)
                          ) ;_ end of if
    ) ;_ end of setq

the second part of my question is, how do I actually select the object in modelspace, from paperspace, without double clicking into the viewport?

[jvillarreal]

Look up Giles PCS2WCS Function.
One way to accomplish the task...
 if the routine starts in paperspace the object selection should occur by:
1. (Setq pt (getpoint))
2. (vla-put-mspace acadDocument :vlax-true)
3. (Setq pt (pcs2wcs pt (acet-currentviewport-ename)))
4. (Setq obj (car (nentselp pt)));;;(Ensure you're in wcs or translate to ucs)
5. (vla-put-mspace acadDocument :vlax-false)

then just continue your routine

**EDIT**
I didn't look at your routine. You'll have to add the text before returning to paperspace or translate necessary points for text placement and rotation to paperspace.

[BlackBox]

Great suggesttion with Gile's pcs2wcs.

However, as I've mentioned to Chris before, this still requires activating the viewport.

Here's a small test:

Code: [Select]

(defun c:FOO  (/ pt e)
  (vl-load-com)
  (if (and (/= "MODEL" (strcase (getvar 'ctab)))
   (setq pt (getpoint)))
    (progn
      (vla-put-mspace
(cond
  (*activeDoc*)
  ((setq *activeDoc*
  (vla-get-activedocument
    (vlax-get-acad-object)))))
:vlax-true)
      (setq pt (pcs2wcs pt (acet-currentviewport-ename)))
      (setq e  (car (nentselp pt)))
      (vla-put-mspace *activeDoc* :vlax-false)
      (princ (entget e))))
  (princ))


[jvillarreal]

Yes, Gile's function is very useful.
I didn't know Chris was trying to avoid activating the viewport.
Selecting an object in modelspace without activating the viewport is possible but selection of the viewport will still be necessary.

An example:

Code: [Select]

(defun test (/ acadObject acadDocument acadModelSpace pt viewport obj)
  (setq acadObject (vlax-get-acad-object)
          acadDocument (vla-get-ActiveDocument acadObject)
          acadModelSpace (vla-get-modelspace acadDocument)
)
(setq pt (getpoint))
(setq viewport (ssname (ssget "_x" (list (cons 0 "VIEWPORT"))) 0 ))
(setq pt (pcs2wcs pt viewport))
(vlax-for i acadModelSpace (and (member (vla-get-objectname i) '("AcDbPolyline" "AcDbLine" "AcDbLWPolyline"))
     (vlax-curve-getParamAtPoint i pt)
     (setq obj i)
)
)
obj
)
(setq obj (test))

Of course, this will only work in layouts containing only one viewport..
otherwise iteration of viewports is necessary to check which contains the point selected.
Hope this helps

[CAB]

Watch out for overlapping viewports.

[Chris]

come on guys, I posted this in two separate web sites because I know that some people dont post in both  
I'll take a look at Gile's function and see.

Alan, overlapping viewports totally slipped my mind, but currently, I am wanting to add this functionality as a way to convince our surveyors to use paperspace more often. My plan is to make their familiar model space tool still able to function without any extra clicks or picks.  Hopefully I wont have to worry about our surveyors moving to overlapping viewports too soon, as even our engineering department rarely use overlapping viewports (on purpose).

[Chris]

Monday's make all the difference.  after looking at the code I added to our main engineering.lsp file (for active space) and thinking about it some more this morning, it does no good to make this a global variable as the active space can change at any time after the drawing is opened.  So, I removed the activespace code and put it directly in the length text program.

[BlackBox]

come on guys, I posted this in two separate web sites because I know that some people dont post in both  

I wasn't picking on you... post this thread as many times as you like. I simply added the link to reduce the number of duplicate suggestions, mate. 

BTW - I'm glad you found a solution.

[jvillarreal]

Anyone have suggestions for enhancement?

Code: [Select]

;(pssel)
;Compatible Objects: '("AcDbLine" "AcDbArc" "AcDbPolyline" "AcDb2dPolyline" "AcDb3dPolyline")

;Return Values
;  In paperspace: A list of vla-objects selected from paperspace in order selected
;  In Modelspace: selection set

;(acet-sys-shift-down) used for removal of objects from list

;Currently uses vlax-curve-getclosestpointto for paperspace selection;

;; PCS2WCS (gile)
;; Translates a point PaperSpace coordinates to WCS coordinates
;; according to the specified viewport
(defun PCS2WCS (pt vp / ang nor scl mat)
  (vl-load-com)
  (and (= (type vp) 'VLA-OBJECT)
       (setq vp (vlax-vla-object->ename vp))
  )
  (setq pt   (trans pt 0 0)
elst (entget vp)
ang  (- (cdr (assoc 51 elst)))
nor  (cdr (assoc 16 elst))
scl  (/ (cdr (assoc 45 elst)) (cdr (assoc 41 elst)))
mat  (mxm
      (mapcar (function (lambda (v) (trans v 0 nor T)))
      '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
      )
      (list (list (cos ang) (- (sin ang)) 0.0)
    (list (sin ang) (cos ang) 0.0)
    '(0.0 0.0 1.0)
      )
    )
  )
  (mapcar '+
 (mxv mat
      (mapcar '+
      (vxs pt scl)
      (vxs (cdr (assoc 10 elst)) (- scl))
      (cdr (assoc 12 elst))
      )
 )
 (cdr (assoc 17 elst))
  )
)
;;(gile)
(defun vxs (v s) (mapcar (function (lambda (x) (* x s))) v))
(defun vxv (v1 v2) (apply '+ (mapcar '* v1 v2)))
(defun trp (m) (apply 'mapcar (cons 'list m)))


;; MXV
;; Applies a transformation matrix to a vector  -Vladimir Nesterovsky-
(defun mxv (m v)
  (mapcar '(lambda (r) (vxv r v)) m)
)


;; MXM
;; Multiplies (combinates) two matrices -Vladimir Nesterovsky-
(defun mxm (m q)
  (mapcar '(lambda (r) (mxv (trp q) r)) m)
)

;;(gile)
(defun vxs (v s) (mapcar (function (lambda (x) (* x s))) v))

(defun 2dPt->3dPt (pt)(list (float (car pt)) (float (cadr pt)) 0.0))
(defun Pt->2dPt (pt)(list (float (car pt)) (float (cadr pt))))

(defun GetVP ( pt / PIQ vpcoll vp# match vpcords inbounds? center cent viewportlist)
 (setq PIQ (Pt->2dPt pt)
      vpcoll (cdr (vports))
 )
 (foreach x vpcoll
    (setq vpcords (cdr x)
          inbounds?
          (mapcar
              '(lambda (cords)
           (mapcar '(lambda (cordspt apt)(- cordspt apt)) cords piq)
               )
            vpcords
          )
    )
   (and
     (not (vl-remove-if 'minusp (list (cadar inbounds?)(caar inbounds?))))
     (not (vl-remove-if-not 'minusp (list (caadr inbounds?)(cadadr inbounds?))))
     (setq center (2dPt->3dPt (mapcar '(lambda (a b) (/ (+ a b) 2.0)) (car vpcords)(cadr vpcords))))
     (vlax-for i (vla-get-paperspace ActDoc)
  (and
     (member (vla-get-objectname i) '("AcDbViewport"))
     (setq cent (vlax-safearray->list (vlax-variant-value (vla-get-center i))))
     (not (member nil (mapcar '(lambda (a b)(= a b)) cent center)))
     (setq viewportlist (append viewportlist (list i)))
  )
     )
   )
 )
   (if (> (length viewportlist) 1)
(nth
 (vl-position
   (apply 'min
     (setq minlist
(mapcar '(lambda (x) (vla-get-height x)) viewportlist)
      )
    )
   minlist
  )
 viewportlist
)
(car viewportlist)
   );if
 
)


(defun SOFP (/ Input pt AMspace onlst distlist objlist mindist)
 (princ "\nSelect Object:")

   (while
     (and
(setq Input (grread T 4 2))
(= (car Input) 5)
     )
     (setq pt (cadr input))
   )

   (setq AMspace (vla-get-modelspace ActDoc))
   (if (setq viewport (getvp pt))
   (progn
   (setq  pt (2dPt->3dPt (pcs2wcs pt viewport))
 onlst '("AcDbLine" "AcDbArc" "AcDbPolyline" "AcDb2dPolyline" "AcDb3dPolyline")
   )
   (vlax-for i AMspace
(and
    (member (vlax-get i 'ObjectName) onlst)
    (setq distlist
(append distlist
 (list
   (distance
(vlax-curve-getclosestpointto i pt)
  pt
    )
  )
)
         objlist  (append objlist (list i))
     )
)
   )
(setq mindist (apply 'min distlist))
(if (= (car input) 25) nil
   (nth (vl-position mindist distlist) objlist)
);
   );progn
  (if (= (car input) 25) nil
   (progn (alert "Point selected is outside viewport(s)!")(exit))
   );
   )
)


(defun PSSel (/ ActDoc *Space* obj ss postn viewport vpss)
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(setq *Space* (vlax-get-property ActDoc (nth (vla-get-ActiveSpace ActDoc)'("PaperSpace" "ModelSpace"))))
(if (eq (vla-get-mspace ActDoc) :vlax-false)
      (while
        (setq obj (sofp))
  (if (acet-sys-shift-down)
(progn
(and ss
  (setq postn (vl-position obj ss))
(if (= (length ss) 1)
   (progn (not (setq ss nil))
  (vla-highlight obj :vlax-false)
   )
     (progn (setq ss (vl-remove obj ss))
  (vla-highlight obj :vlax-false)
   );
)  
)
  );progn
   (cond
 (ss
   (if (member obj ss) (vla-highlight obj :vlax-true)
(progn (setq ss (append ss (list obj))
          vpss (append vpss (list viewport))
       )
       (vla-highlight obj :vlax-true)
)
    );if
  )
  ((not ss)
     (setq ss (append ss (list obj))
     vpss (append vpss (list viewport))
    )
    (vla-highlight obj :vlax-true)
  )
   );cond
  )
      )

   (setq ss (ssget '((-4 . "<OR")(0 . "*POLYLINE")(0 . "ARC")(0 . "LINE")(-4 . "OR>"))))
)
ss
)