need this lisp updated

[Lee Mac]

You would think wouldn't you - but people aren't that way inclined. :wink:

 

I think he asked nicely enough, but it was the fact that he just wanted someone to provide for him, instead of taking the initiative to try to learn something. Maybe I'm just in a bad mood.

[mdbdesign]

defun: mood_changer()

getvar (something something) beer"")

(repeat 10)

[Lee Mac]

now thats an idea.

[alanjt]

come on man, i coded out everything, i just didn't tell him where to put it. i felt the thrown bone was big enough.

 

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)
)

[JeepMaster]

Use this to solve all your money problem...adjust to suit.:D:D

 

(defun: money_maker()

(getvar (anything) money )))

(repeat 1000000)

[chulse]

defun: mood_changer()

getvar (something something) beer"")

(repeat 10)

 

Ha, I like that!

[stevsmith]

mmmm.

I sense a paypal moment coming on!

[Lee Mac]

The VL alternative of course:

 

[b][color=Red]([/color][color=Blue]vlax-invoke[/color][/b]
 [b][color=Red]([/color][color=Blue]vlax-get-property[/color][/b]
   [b][color=Red]([/color][color=Blue]vla-get-ActiveBeer[/color][/b]
     [b][color=Red]([/color][color=Blue]vlax-get-fridge-object[/color][color=Red]))[/color][/b] 'Contents[color=Red][b])[/b][/color] 'Drink[color=Red][b])[/b][/color]

[Lee Mac]

mmmm.

I sense a paypal moment coming on!

 

Steve,

 

I am in no way going to demand payment in return for a donation. The donation is there for those who want to show their gratitude. I am not selling anything.

[alanjt]

Use this to solve all your money problem...adjust to suit.:D:D

 

(defun: money_maker()

(getvar (anything) money )))

(repeat 1000000)

 

(defun money ( / money )
(setq money 0)
(while (print (strcat "$" (vl-princ-to-string (setq money (1+ money))))))
)

 

it's like Print[ing] money :wink:

[mdbdesign]

Hangover not allowed

[alanjt]

The VL alternative of course:

 

[b][color=Red]([/color][color=Blue]vlax-invoke[/color][/b]
 [b][color=Red]([/color][color=Blue]vlax-get-property[/color][/b]
   [b][color=Red]([/color][color=Blue]vla-get-ActiveBeer[/color][/b]
     [b][color=Red]([/color][color=Blue]vlax-get-fridge-object[/color][color=Red]))[/color][/b] 'Contents[color=Red][b])[/b][/color] 'Drink[color=Red][b])[/b][/color]

lol, nice lee

[Lee Mac]

lol, nice lee

 

.. ..

[alanjt]

Steve,

 

I am in no way going to demand payment in return for a donation. The donation is there for those who want to show their gratitude. I am not selling anything.

so i guess everyone should add a paypal option to their sig.

[Lee Mac]

so i guess everyone should add a paypal option to their sig.

 

If they so wish.

[alanjt]

If they so wish.

just seems like it goes against the whole spirit of the forum, but that's just me.

[ReMark]

There is a good reason for the PayPal option. Make believe you don't see it or just squint. OK?:wink:

[JeepMaster]

Since paypal charges you money when you receive them, you actually lose money using paypal.

[Lee Mac]

Since paypal charges you money when you receive them, you actually lose money using paypal.

 

Yes, but what other options are available for the same operation?

[stevsmith]

Steve,

 

I am in no way going to demand payment in return for a donation. The donation is there for those who want to show their gratitude. I am not selling anything.

 

I do know that Lee. Maybe it's just my sarcastical sense of humor going into overdrive.

 

Anyway. I defended the paypal thing.

 

But lets not dwell go to deep on this thread.