LISP: entmod doesn't work on viewports in BC10 10.1.4 (Trial)

Roy Klein Gebbinck · October 2009

This code works fine in BC7. Does anybody know why it fails in BC10 10.1.4 (Trial)?

(defun c:ShiftVP ( / )
    (if
       (and
          (setq entName (car (entsel "Selelect viewport: ")))
           (setq entLst (entget entName))
            (setq entType (cdr (assoc 0 entLst)))
         (or
               (= entType "VIEWPORT")
                (and
                  (= entType "LWPOLYLINE")
                  (setq entName (cdr (cadr (member '(102 . "{ACAD_REACTORS") entLst))))
                 (setq entLst (entget entName))
                    (setq entType (cdr (assoc 0 entLst)))
             )
         )
         (= entType "VIEWPORT")
        )
     (progn
            (terpri)
          (princ entLst)
            (setq entLst (subst (list 12 0.0 0.0 0.0) (assoc 12 entLst) entLst))
          (terpri)
          (princ entLst)
            (entmod entLst) ; entmod works in BC7 but not in BC10, using entmake will work in BC10 on unclipped viewports
     )
     (princ "\nThis is not a viewport ")
   )
 (princ)
)

Its_Alive · October 2009

here's a hack you might try

(defun c:ShiftVP ( / app doc entlst entname enttype vpobj)
  (setq APP (vlax-get-acad-object)
        DOC (vla-get-activedocument APP)
  )
  (if (and
        (setq entName (car (entsel "Selelect viewport: ")))
        (setq entLst (entget entName))
        (setq entType (cdr (assoc 0 entLst)))
        (or
          (= entType "VIEWPORT")
          (and
            (= entType "LWPOLYLINE")
            (setq entName (cdr (cadr (member '(102 . "{ACAD_REACTORS")
                                             entLst
                                     )
                               )
                          )
            )
          )
          (setq entLst (entget entName))
          (setq entType (cdr (assoc 0 entLst)))
        )
        (= entType "VIEWPORT")
      )
    (progn
      (setq vpObj (vlax-EName->vla-Object entname))
      (vla-put-mspace doc :vlax-true)
      (vla-put-activepviewport doc vpObj)
      (vla-zoomcenter app (vlax-3d-point 0 0 0) 1)
      (vla-put-mspace doc :vlax-false)
    )
    (princ "\nThis is not a viewport ")
  )
  (princ)
)

Roy Klein Gebbinck · October 2009

Thank you Daniel. Your "hack" works. You did however move one parenthesis to a wrong place.

If you want to test this:

Create a pologonal viewport.
Use draworder with the option back on the viewport.
If the user now selects the viewport he is in fact selecting the lwpolyline.

But thanks again.

Your code with parenthesis in the right place:

(defun c:ShiftVP ( / app doc entName entLst entType vpObj)
   (setq
     app (vlax-get-acad-object)
        doc (vla-get-activedocument app)
  )
 (if
       (and
          (setq entName (car (entsel "Selelect viewport: ")))
           (setq entLst (entget entName))
            (setq entType (cdr (assoc 0 entLst)))
         (or
               (= entType "VIEWPORT")
                (and
                  (= entType "LWPOLYLINE")
                  (setq entName (cdr (cadr (member '(102 . "{ACAD_REACTORS") entLst))))
                 (setq entLst (entget entName))
                    (setq entType (cdr (assoc 0 entLst)))
             )
         )
         (= entType "VIEWPORT")
        )
     (progn
            (setq vpObj (vlax-EName->vla-Object entname))
          (vla-put-mspace doc :vlax-true)
           (vla-put-activepviewport doc vpObj)
           (vla-zoomcenter app (vlax-3d-point 0 0 0) 1)
          (vla-put-mspace doc :vlax-false)
      )
     (princ "\nThis is not a viewport ")
   )
 (princ)
)

Roy Klein Gebbinck · October 2009

Daniel: your "hack" somehow also changes the vp scale.

Its_Alive · October 2009

Sorry my bad, see if this one maintains the scale

(defun c:ShiftVP ( / app doc entlst entname enttype vpcscale vpobj)
  (setq app (vlax-get-acad-object)
        doc (vla-get-activedocument app)
  )
  (if (and
        (setq entName (car (entsel "Select viewport: ")))
        (setq entLst (entget entName))
        (setq entType (cdr (assoc 0 entLst)))
        (or
          (= entType "VIEWPORT")
          (and
            (= entType "LWPOLYLINE")
            (setq entName (cdr (cadr (member '(102 . "{ACAD_REACTORS")
                                             entLst
                                     )
                               )
                          )
            )
            (setq entLst (entget entName))
            (setq entType (cdr (assoc 0 entLst)))
          )
        )
        (= entType "VIEWPORT")
      )
    (progn
      (setq vpObj (vlax-EName->vla-Object entname))
      (setq vpcscale (vla-get-customscale vpObj))
      (vla-put-mspace doc :vlax-true)
      (vla-put-activepviewport doc vpObj)
      (vla-zoomcenter app (vlax-3d-point 0 0 0) 1)
      (vla-put-mspace doc :vlax-false)
      (vla-put-customscale vpObj vpcscale)
    )
    (princ "\nThis is not a viewport ")
  )
  (princ)
)

Roy Klein Gebbinck · October 2009

Great Daniel. The final result:

(defun c:ShiftVP ( / entName entLst entType pt1 pt2 dist ang vpScale vpOldCenter vpNewCenter app doc vpObj vpOldScale)
   (if
       (and
          (setq entName (car (entsel "\nSelelect viewport: ")))
         (setq entLst (entget entName))
            (setq entType (cdr (assoc 0 entLst)))
         (or
               (= entType "VIEWPORT")
                (and
                  (= entType "LWPOLYLINE")
                  (setq entName (cdr (cadr (member '(102 . "{ACAD_REACTORS") entLst))))
                 (setq entLst (entget entName))
                    (setq entType (cdr (assoc 0 entLst)))
             )
         )
         (= entType "VIEWPORT")
            (setq pt1 (getpoint "\nEnter base point: "))
          (= (type pt1) 'list)
          (setq pt2 (getpoint pt1 "\nEnter second point: " ))
           (= (type pt2) 'list)
      )
     (progn
            (setvar "cmdecho" 0)
          (command "_.undo" "_begin")
           (setq
             pt1 (trans pt1 1 0)
               pt2 (trans pt2 1 0)
               dist (distance pt1 pt2)
               ;; if the vp center moves to the right the vp content shifts to the left so (angle pt2 pt1) is used here:
             ang (angle pt2 pt1)
               vpScale (/ (cdr (assoc 41 entLst)) (cdr (assoc 45 entLst)))
               vpOldCenter (cdr (assoc 12 entLst))
               vpNewCenter (polar vpOldCenter ang (/ dist vpScale))
              app (vlax-get-acad-object)
                doc (vla-get-activedocument app)
              vpObj (vlax-ename->vla-object entname)
             vpOldScale (vla-get-customscale vpObj)
            )
         (vla-put-mspace doc :vlax-true)
           (vla-put-activepviewport doc vpObj)
           (vla-zoomcenter app (vlax-3d-point (trans vpNewCenter 2 0)) 1)
            (vla-put-mspace doc :vlax-false)
          (vla-put-customscale vpObj vpOldScale)
            (command "_.undo" "_end")
     )
     (princ "\nError: not a viewport or an invalid point ")
    )
 (princ)
)

LISP: entmod doesn't work on viewports in BC10 10.1.4 (Trial)

Comments