A Little help with my lisp routine

[hmsilva]

Just for testing

copy and paste in the command line

 

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

 

tell me what you get

[BrianTFC]

this is what i got

#

[hmsilva]

is not a problem with "activex", I do not see what is.

Others lisps work well on that machine?

[BrianTFC]

yeah they all work just fine. that's whats got me stumped.

[hmsilva]

Me too...

I google the error and found several errors like that,

some caused by installation error,and solved by repairing or reinstalling,

or by other error in Support File Search Path, solved placing the correct path.

See if you can find any errors in the paths...

Maybe someone who had the same error might help?

 

Henrique

[BrianTFC]

hmsilva,

 

Hope you had a great holiday and a Happy New Years eve. I never could figure out why i counldn't run it on an older verison of Autocad, but its okay i use 2012 on my main computer. i was wondering how i can i make the lisp rountine run until told to stop. i know it has to do with a "while" or some sort of loop. i not every good at finding the right place to put it in a routine i'm still learning. is it after the loop command?

 

Brian

[Lee Mac]

Try the following quick program Brian:

 

([color=BLUE]defun[/color] c:psave ( [color=BLUE]/[/color] dfn dir doc dwg llp sel ssc sso tmp urp )
   ([color=BLUE]setq[/color] doc ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color]))
         ssc ([color=BLUE]vla-get-selectionsets[/color] doc)
         dir ([color=BLUE]getvar[/color] 'dwgprefix)
   )
   ([color=BLUE]if[/color] ([color=BLUE]vl-catch-all-error-p[/color] ([color=BLUE]setq[/color] sso ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vla-item[/color] ([color=BLUE]list[/color] ssc [color=MAROON]"wbset"[/color]))))
       ([color=BLUE]setq[/color] sso ([color=BLUE]vla-add[/color] ssc [color=MAROON]"wbset"[/color]))
       ([color=BLUE]vla-clear[/color] sso)
   )
   ([color=BLUE]while[/color] ([color=BLUE]setq[/color] sel (LM:ssget [color=MAROON]"\nSelect Border: "[/color] '([color=MAROON]"_+.:E:S"[/color] ((0 . [color=MAROON]"INSERT,LWPOLYLINE"[/color])))))
       ([color=BLUE]vla-getboundingbox[/color] ([color=BLUE]vlax-ename->vla-object[/color] ([color=BLUE]ssname[/color] sel 0)) 'llp 'urp)
       ([color=BLUE]vla-select[/color] sso [color=BLUE]acselectionsetwindow[/color] llp urp)
       ([color=BLUE]if[/color] ([color=BLUE]<[/color] 0 ([color=BLUE]vla-get-count[/color] sso))
           ([color=BLUE]progn[/color]
               ([color=BLUE]vlax-for[/color] obj sso
                   ([color=BLUE]if[/color]
                       ([color=BLUE]and[/color]
                           ([color=BLUE]=[/color] [color=MAROON]"AcDbText"[/color] ([color=BLUE]vla-get-objectname[/color] obj))
                           ([color=BLUE]wcmatch[/color] ([color=BLUE]vla-get-textstring[/color] obj) [color=MAROON]"@*"[/color])
                       )
                       ([color=BLUE]setq[/color] dwg ([color=BLUE]vla-get-textstring[/color] obj))
                   )
               )
               ([color=BLUE]if[/color] ([color=BLUE]findfile[/color] ([color=BLUE]setq[/color] dfn ([color=BLUE]strcat[/color] dir dwg [color=MAROON]".dwg"[/color])))
                   ([color=BLUE]progn[/color]
                       ([color=BLUE]setq[/color] tmp 1)
                       ([color=BLUE]while[/color] ([color=BLUE]findfile[/color] ([color=BLUE]setq[/color] dfn ([color=BLUE]strcat[/color] dir dwg [color=MAROON]"("[/color] ([color=BLUE]itoa[/color] ([color=BLUE]setq[/color] tmp ([color=BLUE]1+[/color] tmp))) [color=MAROON]").dwg"[/color]))))
                   )
               )
               ([color=BLUE]vla-wblock[/color] doc dfn sso)
               ([color=BLUE]vla-clear[/color] sso)
           )
       )
   )
   ([color=BLUE]vla-delete[/color] sso)
   ([color=BLUE]princ[/color])                
)

[color=GREEN];; ssget  -  Lee Mac[/color]
[color=GREEN];; A wrapper for the ssget function to permit the use of a custom selection prompt[/color]
[color=GREEN];;[/color]
[color=GREEN];; Arguments:[/color]
[color=GREEN];; msg    - selection prompt[/color]
[color=GREEN];; params - list of ssget arguments[/color]

([color=BLUE]defun[/color] LM:ssget ( msg params [color=BLUE]/[/color] sel )
   ([color=BLUE]princ[/color] msg)
   ([color=BLUE]setvar[/color] 'nomutt 1)
   ([color=BLUE]setq[/color] sel ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]ssget[/color] params))
   ([color=BLUE]setvar[/color] 'nomutt 0)
   ([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]vl-catch-all-error-p[/color] sel)) sel)
)

([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

[hmsilva]

Brian,

Happy New Year too

(defun c:psave (/ ss mn mx sst)
 (vl-load-com)
 (while (setq ss (ssget "_:S:E" '((0 . "INSERT,LWPOLYLINE"))))
   (progn
     (vla-getboundingbox
(vlax-ename->vla-object (ssname ss 0))
'mn
'mx
     )
     (setq sst (ssget "W"
        (trans (vlax-safearray->list mn) 0 1)
        (trans (vlax-safearray->list mx) 0 1)
        '((0 . "text") (1 . "~(*"))
 )
     )
     (if (= (findfile (strcat (getvar "dwgprefix")
         (cdr (assoc 1 (entget (ssname sst 0))))
         ".dwg"
        )
     )
     nil
  )
(progn
  (command "-wblock"
    (strcat (getvar "dwgprefix")
     (cdr (assoc 1 (entget (ssname sst 0))))
    )
    " "
    "0"
    "WINDOW"
    (trans (vlax-safearray->list mn) 0 1)
    (trans (vlax-safearray->list mx) 0 1)
    ""
  )
  (command "oops")
)
;; progn
(alert
  (strcat "\nThe "
   (cdr (assoc 1 (entget (ssname sst 0))))
   ".dwg already exists in the current directory!!!"
  )
)
     )
     ;; if
   )
   ;; progn
 )
 ;; while
 (princ)
)

 

Henrique

[BrianTFC]

Thanks Guys for all the help...

[hmsilva]

You're welcome, BrianTFC

 

Henrique

[Lee Mac]

No worries Brian