Community
I think the problem is with the Original block Insertion Point.
I modified your block and with the below code I was able to update the MS coord.
I did following changes to the block.[Please find the attached file]
1.Deleted the constraints.
2.Moved the insertion point of block to 0,0,0
3.Added a Basepoint parameter.
4.Included the base point parameter to the stretch action.
5.Reinserted the block again.
6. Run the below command.
(vl-load-com)
(Defun C:PSMS (/ Obj PScrd MScrd EOBJ )
(setq Obj (entsel))
(setq PScrd (cdr(assoc 10 (entget (car Obj)))))
(setq MScrd (trans PScrd 3 2))
(setq EOBJ (vlax-ename->vla-object (car Obj)))
(if (= (vla-get-hasattributes EOBJ) :vlax-true)
(progn
(foreach N (vlax-safearray->list
(variant-value
(vla-getattributes EOBJ)
)
)
(if (= (vla-get-tagstring N) "X")
(vla-put-textstring N (car MScrd)))
(if (= (vla-get-tagstring N) "Y")
(vla-put-textstring N (cadr MScrd))
)
);for each
);progn
);if
(princ)
);defun
| 
| 
For PCS to WCS (with an active viewport) you will need to use:
(trans (trans <point> 3 2) 2 0)
@skintsubby wrote:Your line "Within an active viewport" confused me.. for instance. I'm in Papersapce. I have one viewport (which is rotated) the block is in paperspace as well. There are no active viewports at the moment.
Mark,
Since we are transforming the coordinates from PCS (3) (aka PSDCS) to the DCS (2) of the active viewport, and then from DCS (2) to WCS (0), the viewport in question needs to be active to ensure that the correct DCS is used by the trans function. With no viewport active, the trans function is translating from PCS to WCS (since the Paperspace Layout viewport is the active viewport), and hence not accounting for the viewport configuration.
For transformation with an inactive viewport, I would suggest using gile's PCS2WCS function in conjunction with the viewport entity - here is a very quick draft:
(defun c:test ( / br ip vp )
(if
(and
(setq br (LM:ssget "\nSelect block: " '("_+.:E:S:L" ((0 . "INSERT") (66 . 1)))))
(setq vp (LM:ssget "\nSelect vport: " '("_+.:E:S" ((0 . "VIEWPORT")))))
)
(progn
(setq br (vlax-ename->vla-object (ssname br 0))
ip (PCS2WCS (vlax-get br 'insertionpoint) (ssname vp 0))
)
(foreach a (vlax-invoke br 'getattributes)
(if (= "X" (strcase (vla-get-tagstring a)))
(vla-put-textstring a (rtos (car ip) 2 0))
(vla-put-textstring a (rtos (cadr ip) 2 0))
)
)
)
)
(princ)
)
;; PCS2WCS (gile)
;; Translates a PCS point to WCS based on the supplied Viewport
;;
;; (PCS2WCS pt vp) is the same as (trans (trans pt 3 2) 2 0) when vp is active
;;
;; pnt : PCS point
;; ent : Viewport ename
(defun PCS2WCS ( pnt ent / ang enx mat nor scl )
(setq pnt (trans pnt 0 0)
enx (entget ent)
ang (- (cdr (assoc 51 enx)))
nor (cdr (assoc 16 enx))
scl (/ (cdr (assoc 45 enx)) (cdr (assoc 41 enx)))
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 pnt scl)
(vxs (cdr (assoc 10 enx)) (- scl))
(cdr (assoc 12 enx))
)
)
(cdr (assoc 17 enx))
)
)
;; Matrix Transpose - Doug Wilson
;; Args: m - nxn matrix
(defun trp ( m )
(apply 'mapcar (cons 'list m))
)
;; Matrix x Matrix - Vladimir Nesterovsky
;; Args: m,n - nxn matrices
(defun mxm ( m n )
((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
)
;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n
(defun mxv ( m v )
(mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)
;; Vector x Scalar - Lee Mac
;; Args: v - vector in R^n, s - real scalar
(defun vxs ( v s )
(mapcar '(lambda ( n ) (* n s)) v)
)
;; ssget - Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - selection prompt
;; arg - list of ssget arguments
(defun LM:ssget ( msg arg / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget arg))
(setvar 'nomutt 0)
(if (not (vl-catch-all-error-p sel)) sel)
)
(vl-load-com) (princ)
@ Lee,
Like always Excellent code Lee.
Mark,
Have you checked Lee's code ?
I slightly modified Lee's code to avoid asking to select Viewport, as you said you are working on single viewport.
Full code in here.
Spoiler
(defun c:test ( / br ip vp )
;;Blackbox
(defun cvprt()
(setq ss
(ssget "_x"
(list '(0 . "VIEWPORT")
(cons 410 (getvar 'ctab))
'(-4 . "<NOT")
'(69 . 1) ; <-- Ignore pviewport
'(-4 . "NOT>")
)
)
)
);cvprt
(if
(and
(setq br (LM:ssget "\nSelect block: " '("_+.:E:S:L" ((0 . "INSERT") (66 . 1)))))
;(setq vp (LM:ssget "\nSelect vport: " '("_+.:E:S" ((0 . "VIEWPORT")))))
(setq vp (cvprt))
)
(progn
(setq br (vlax-ename->vla-object (ssname br 0))
ip (PCS2WCS (vlax-get br 'insertionpoint) (ssname vp 0))
)
(foreach a (vlax-invoke br 'getattributes)
(if (= "X" (strcase (vla-get-tagstring a)))
(vla-put-textstring a (rtos (car ip) 2 0))
(vla-put-textstring a (rtos (cadr ip) 2 0))
)
)
)
)
(princ)
)
;; PCS2WCS (gile)
;; Translates a PCS point to WCS based on the supplied Viewport
;;
;; (PCS2WCS pt vp) is the same as (trans (trans pt 3 2) 2 0) when vp is active
;;
;; pnt : PCS point
;; ent : Viewport ename
(defun PCS2WCS ( pnt ent / ang enx mat nor scl )
(setq pnt (trans pnt 0 0)
enx (entget ent)
ang (- (cdr (assoc 51 enx)))
nor (cdr (assoc 16 enx))
scl (/ (cdr (assoc 45 enx)) (cdr (assoc 41 enx)))
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 pnt scl)
(vxs (cdr (assoc 10 enx)) (- scl))
(cdr (assoc 12 enx))
)
)
(cdr (assoc 17 enx))
)
)
;; Matrix Transpose - Doug Wilson
;; Args: m - nxn matrix
(defun trp ( m )
(apply 'mapcar (cons 'list m))
)
;; Matrix x Matrix - Vladimir Nesterovsky
;; Args: m,n - nxn matrices
(defun mxm ( m n )
((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
)
;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n
(defun mxv ( m v )
(mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)
;; Vector x Scalar - Lee Mac
;; Args: v - vector in R^n, s - real scalar
(defun vxs ( v s )
(mapcar '(lambda ( n ) (* n s)) v)
)
;; ssget - Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - selection prompt
;; arg - list of ssget arguments
(defun LM:ssget ( msg arg / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget arg))
(setvar 'nomutt 0)
(if (not (vl-catch-all-error-p sel)) sel)
)
(vl-load-com) (princ)
@Ajilal.Vijayan wrote:@ Lee,
Like always Excellent code Lee.
Thank you Ajilal 
@skintsubby wrote:Lee
Apoligies for not replying yesterday.
I've spent this morning incorporating your code into mine (which is a bit of a fudged version of Ajilal's). and didn't want to reply until I had it all working perfectly. which it now does.
Excellent, you're welcome Mark.
![Autodesk Design & Make Report](https://forums.autodesk.com/t5/image/serverpage/image-id/1350519iCB55845EBFC43016/image-size/large?v=v2&px=999" "Autodesk Design & Make Report")
