need this lisp updated

[CadTechJGC184]

Hello All,

 

This lisp takes my view port and adds the outline of that view port and puts it in the model space. this way I know my drawing limits. this lisp puts the outline on the current layer. i need it to put it on the Defpoints layer no matter what the current layer is on.

 

thanks in advance!

[CadTechJGC184]

here is the code:

 

(defun c:vpo (/ ad ss ent pl plist xy n vpbl vpur msbl msur ven vpno ok)

(setq ad (vla-get-activedocument (vlax-get-acad-object)))

(if (= (getvar "tilemode") 0)

(progn

(if (= (getvar "cvport") 1)

(progn

(if (setq ss (ssget ":E:S" '((0 . "VIEWPORT"))))

(progn

(setq ent (ssname ss 0))

(setq vpno (dxf 69 (entget ent)))

(vla-Display (vlax-ename->vla-object ent) :vlax-true)

(vla-put-mspace ad :vlax-true) ; equal (command "._mspace")

; this to ensure trans later is working on correct viewport

(setvar "cvport" vpno)

; (vla-put-mspace ad :vlax-false) ; equal (command "._pspace")

(setq ok T)

)

)

)

(setq ent (vlax-vla-object->ename (vla-get-activepviewport ad))

ok T

)

)

(if ok

(progn

(setq ven (vlax-ename->vla-object ent))

(if (/= 1 (logand 1 (dxf 90 (entget ent)))) ; detect perspective

(if (= (vla-get-clipped ven) :vlax-false)

(progn ; not clipped

(vla-getboundingbox ven 'vpbl 'vpur)

(setq vpbl (trans (vlax-safearray->list vpbl) 3 2)

msbl (trans vpbl 2 1)

msbl (trans msbl 1 0)

vpur (trans (vlax-safearray->list vpur) 3 2)

msur (trans vpur 2 1)

msur (trans msur 1 0)

vpbr (list (car vpur) (cadr vpbl)0)

msbr (trans vpbr 2 1)

msbr (trans msbr 1 0)

vpul (list (car vpbl) (cadr vpur)0)

msul (trans vpul 2 1)

msul (trans msul 1 0)

plist (list (car msbl) (cadr msbl)

(car msbr) (cadr msbr)

(car msur) (cadr msur)

(car msul) (cadr msul)

)

)

)

(progn ; clipped

(setq pl (entget (dxf 340 (entget ent)))

plist (vla-get-coordinates

(vlax-ename->vla-object (dxf -1 pl))

)

plist (vlax-safearray->list (vlax-variant-value plist))

n 0

pl nil

)

(repeat (/ (length plist) 2)

(setq xy (trans (list (nth n plist) (nth (1+ n) plist)) 3 2)

xy (trans xy 2 1)

xy (trans xy 1 0)

pl (cons (car xy) pl)

pl (cons (cadr xy) pl)

n (+ n 2)

)

)

(setq plist (reverse pl))

)

)

)

(setq plist (ax:List->VariantArray plist))

(vla-Put-Closed

(vla-AddLightWeightPolyline

(vla-get-ModelSpace ad)

plist

)

:vlax-True

)

)

)

)

)

(if ss(vla-put-mspace ad :vlax-false)) ; equal (command "._pspace"))

(princ)

)

vp-outline.lsp

[mdbdesign]

Just put this line on your button:

^C^C-la;set;Defpoints;;_vpo

[CadTechJGC184]

i have no clue what that means or how to do it. I'm sorry, but writing or re-writing is not my thing. not yet!! hahaha

[ReMark]

CadTech: You can edit any lisp file with an ASCII text editor like Notepad (comes with Windows). It isn't that difficult. Why, it's so easy even a.....

[alanjt]

i have no clue what that means or how to do it. I'm sorry, but writing or re-writing is not my thing. not yet!! hahaha

i like that, i guess requesting is your 'thing'?

[alanjt]

oh, what the...

 

 

(and (tblsearch "layer" "Defpoints")
    (vla-put-layer
      (vlax-ename->vla-object
        (ssname
          (ssget "_L"
                 (list (cons 8 (getvar "clayer"))
                       (cons 410 "Model")
                       (cons 0 "LWPOLYLINE")
                 ) ;_ list
          ) ;_ ssget
          0
        ) ;_ ssname
      ) ;_ vlax-ename->vla-object
      "Defpoints"
    ) ;_ vla-put-layer
) ;_ and

[CadTechJGC184]

ReMark...... I get confused with all the (( >

[CadTechJGC184]

alanjt,

 

Is that an add on a new lisp?

 

If it'a an add on? where do i add it?

[CadTechJGC184]

hahahaha REQUESTING is deffently my THING!! hahahaha for now!!

[ReMark]

Type it as you see it. The ^ is called a caret and can be found at top of the number 6 key on your keyboard.

[mdbdesign]

How about copy and paste???

I find out it is very handy typing accelerator

[Lee Mac]

i like that, i guess requesting is your 'thing'?

 

And I thought I'd be the one suckered into doing it.. :wink:

[Lee Mac]

i have no clue what that means or how to do it. I'm sorry, but writing or re-writing is not my thing. not yet!! hahaha

 

Have you tried learning? Or are you stubbornly avoiding such a task?

 

After all, this is a help & advice site... not a LISP free request site.. Lets face it, ask anyone out there to re-write your program for you, and no doubt they'll come back with, "Ok, that'll be £...."

[alanjt]

Have you tried learning? Or are you stubbornly avoiding such a task?

 

After all, this is a help & advice site... not a LISP free request site.. Lets face it, ask anyone out there to re-write your program for you, and no doubt they'll come back with, "Ok, that'll be £...."

wow, you've really changed your tone.

[alanjt]

And I thought I'd be the one suckered into doing it.. :wink:

eh, i was bored (forgot my book at the house).

[Lee Mac]

wow, you've really changed your tone.

 

I think I prefer "Come to my senses".

[JeepMaster]

Seems like no one wants to help. Here's my 2 cents. It might not be the best solution because there's no error trap, but it works. Changes are highlighted in red.

;;; vp-outline.lsp (VPO)
;;;
;;; Creates a polyline in modelspace that
;;; has the outline of the selected viewport.
;;; Supports clipped viewports.
;;; If vp-outline is called when in mspace it detects
;;; the active viewport.
;;;
;;; c:vp-outline (C:VPO)
;;;
;;; By Jimmy Bergmark
;;; Copyright (C) 1997-2006 JTB World, All Rights Reserved
;;; Website: www.jtbworld.com
;;; E-mail: info@jtbworld.com
;;;
;;; 2000-04-10
;;; 2003-11-19 Added support for drawing the outline in other ucs/view than world/current
;;;
;;; 2006-04-06 Added support for twisted views Tom Beauford
;;;
;;; Tested on AutoCAD 2000, 2000i, 2002, 2004, 2006, 2007
(vl-load-com)

(defun dxf (n ed) (cdr (assoc n ed)))

(defun ax:List->VariantArray (lst)
 (vlax-Make-Variant
   (vlax-SafeArray-Fill
     (vlax-Make-SafeArray
       vlax-vbDouble
       (cons 0 (- (length lst) 1))
     )
     lst
   )
 )
)

(defun c:VPO (/ ad ss ent pl plist xy n vpbl vpur msbl msur ven vpno ok [color=Red]OL[/color])

 [color=Red](setq OL (getvar "CLAYER"))
 (setvar "CLAYER" "defpoints")[/color]
 (setq ad (vla-get-activedocument (vlax-get-acad-object)))
 (if (= (getvar "tilemode") 0)
   (progn
     (if (= (getvar "cvport") 1)
       (progn
         (if (setq ss (ssget ":E:S" '((0 . "VIEWPORT"))))
           (progn
             (setq ent (ssname ss 0))
             (setq vpno (dxf 69 (entget ent)))
             (vla-Display (vlax-ename->vla-object ent) :vlax-true)
             (vla-put-mspace ad :vlax-true) ; equal (command "._mspace")
             ; this to ensure trans later is working on correct viewport
             (setvar "cvport" vpno)
;              (vla-put-mspace ad :vlax-false) ; equal (command "._pspace")
             (setq ok T)
           )
         )
       )
       (setq ent (vlax-vla-object->ename (vla-get-activepviewport ad))
             ok  T
       )
     )
     (if ok
       (progn
         (setq ven (vlax-ename->vla-object ent))
         (if (/= 1 (logand 1 (dxf 90 (entget ent)))) ; detect perspective
           (if (= (vla-get-clipped ven) :vlax-false)
              (progn                 ; not clipped
                (vla-getboundingbox ven 'vpbl 'vpur)
                  (setq vpbl  (trans (vlax-safearray->list vpbl) 3 2)
                        msbl  (trans vpbl 2 1)
                        msbl  (trans msbl 1 0)
                        vpur  (trans (vlax-safearray->list vpur) 3 2)
                        msur  (trans vpur 2 1)
                        msur  (trans msur 1 0)
                        vpbr (list (car vpur) (cadr vpbl)0)
                        msbr  (trans vpbr 2 1)
                        msbr  (trans msbr 1 0)
                        vpul (list (car vpbl) (cadr vpur)0)
                        msul  (trans vpul 2 1)
                        msul  (trans msul 1 0)
                        plist (list (car msbl) (cadr msbl)
                                           (car msbr) (cadr msbr)
                                           (car msur) (cadr msur)
                                           (car msul) (cadr msul)
                                    )
                   )
              )
              (progn                 ; clipped
                (setq pl    (entget (dxf 340 (entget ent)))
                      plist (vla-get-coordinates
                              (vlax-ename->vla-object (dxf -1 pl))
                            )
                      plist (vlax-safearray->list (vlax-variant-value plist))
                      n     0
                      pl    nil
                )
                (repeat (/ (length plist) 2)
                  (setq xy (trans (list (nth n plist) (nth (1+ n) plist)) 3 2)
                        xy  (trans xy 2 1)
                        xy  (trans xy 1 0)
                        pl (cons (car xy) pl)
                        pl (cons (cadr xy) pl)
                        n  (+ n 2)
                  )
                )
                (setq plist (reverse pl))
              )
           )
         )
         (setq plist (ax:List->VariantArray plist))
         (vla-Put-Closed
           (vla-AddLightWeightPolyline
             (vla-get-ModelSpace ad)
             plist
           )
           :vlax-True
         )
       )
     )
   )
 )
 (if ss(vla-put-mspace ad :vlax-false)) ; equal (command "._pspace"))
 [color=Red](setvar "CLAYER" OL)[/color]
 (princ)
)

[Lee Mac]

Seems like no one wants to help.

 

Its not that we don't want to help, we will gladly offer our help - but "serving" someone is another matter entirely imo.

[JeepMaster]

Its not that we don't want to help, we will gladly offer our help - but "serving" someone is another matter entirely imo.

I guess he could ask more nicely and at least try to put the code in himself and post what he did.

 

Hey Lee, I see that you have a paypal link on your sig. Good one. You must be making a killing with the amount of people you're helping out here. You really should add a note on the bottom of your sig telling people to donate if they like your code, or else people would not know what that paypal account is for. "--Have a LISP request? Send me money first--":D:D:D