Jump to content

Offset LISP using VLA-OFFSET & VLA-PUT-LAYER... Need Help


tmelancon

Recommended Posts

Hello, I currently use a routine that offsets a line in both directions based on a specified distance in the routine. After we run the command we usually have to select the two offset lines and put them on a specific layer, in this case "Structure".

 

I am trying to just add to the routine so the offset lines are automatically put on that layer for us but for some reason when we run the routine its putting all 3 lines (the original, and the two offset lines) on that layer. Can someone review it over and respond. Thanks

 

(defun C:OFF (/ pickEnt pickObj offDist)
 (vl-load-com)
 (setq offDist 0.0812)
 (while 
(setq pickEnt (entsel))
   (cond ((and pickEnt (setq pickObj (vlax-EName->vla-Object (car pickEnt))) offDist)
          (vla-put-layer pickObj "STRUCTURE" )
      (vla-Offset pickObj offDist)
      (vla-Offset pickObj (- offDist))
      )
     ) ;_ end of cond
    ) ;_ end of while
  (princ)
 ) ;_ end of defun

Link to comment
Share on other sites

Hi,

 

Be careful to have the layer name "STRUCTURE" into your drawing before running the routine.

 

(defun c:Test (/ o s)
 (setq o 0.0812)
 (while (setq s (ssget "_+.:S:E:L" '((0 . "*LINE,CIRCLE,ARC,ELLIPSE"))))
   (foreach v (list o (- o))
     (vla-Offset (vlax-EName->vla-Object (ssname s 0)) v)
     (vla-put-layer (vlax-EName->vla-Object (entlast)) "STRUCTURE")
     )
   )
 (princ)
) (vl-load-com)

Link to comment
Share on other sites

I believe I have it now, just took me a little bit of reorganizing of where I was putting the step in and out of current layer.

(defun C:OFF (/ pickEnt pickObj offDist OLDLAYR *ERROR*)
 (vl-load-com)
(defun *error* (msg)
   (if oldlayr (setvar "clayer" oldlayr))
   (if msg (prompt msg))
   (princ)
 )
 (setq offDist 0.0812)
 (while 
 (setq oldlayr (getvar "clayer"))
 (command "._-layer" "s" "STRUCTURE" "")
(setq pickEnt (entsel))
   (cond ((and pickEnt (setq pickObj (vlax-EName->vla-Object (car pickEnt))) offDist)
          (vla-put-layer pickObj "STRUCTURE" )
      (vla-Offset pickObj offDist)
      (vla-Offset pickObj (- offDist))
          (vla-put-layer pickObj OLDLAYR )
          (command "._-layer" "s" oldlayr "")
      )
     ) ;_ end of cond
    ) ;_ end of while
  (princ)
 ) ;_ end of defun

Link to comment
Share on other sites

Oh I just noticed you posted.. Wow well its obvious who has better lisp writing skills.. gosh I wish I was that good. I am getting better but definitely a noob when it comes to how I write. meehh:o I really wish I could further advance my lisp knowledge and programming knowledge. Thank you so much for your help it is greatly appreciate!!

Link to comment
Share on other sites

Oh I just noticed you posted.. Wow well its obvious who has better lisp writing skills.. gosh I wish I was that good. I am getting better but definitely a noob when it comes to how I write. meehh:o I really wish I could further advance my lisp knowledge and programming knowledge. Thank you so much for your help it is greatly appreciate!!

 

:)

 

You are most welcome .

 

Practice and practice to become experienced guy. ;)

Link to comment
Share on other sites

Looks like you guys have been posting since I was pulled into a meeting - but I'll post this anyway. :)

 

This will ensure that the dependent layer is available, handles some misc. entity overrides, supports multiple entity selection, and supports UNDO:

 

(defun c:FOO (/ *error* _Offset acDoc layerName left right ss)

 (defun *error* (msg)
   (if ss (vla-delete ss))
   (if acDoc (vla-endundomark acDoc))
   (cond ((not msg))                                                   ; Normal exit
         ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
         ((princ (strcat "\n** Error: " msg " ** ")))                  ; Fatal error, display it
   )
   (princ)
 )

 (defun _Offset (x dir layerName)
   (foreach y (vlax-invoke x 'offset dir)
     (vla-put-color y acbylayer)
     (vla-put-layer y layerName)
     (vla-put-linetype y "bylayer")
   )
 )

 (if (ssget "_:L" '((0 . "ARC,CIRCLE,ELLIPSE,*LINE")))
   (progn
     (vla-startundomark
       (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
     )
     (vla-add (vla-get-layers acDoc) (setq layerName "STRUCTURE"))
     (setq left  0.0812
           right (- 0.0812)
     )
     (vlax-for x (setq ss (vla-get-activeselectionset acDoc))
       (_Offset x left layerName)
       (_Offset x right layerName)
     )
   )
 )

 (*error* nil)
)

 

 

 

Cheers

Link to comment
Share on other sites

Like Black box I would use in the simple code version above (setvar "clayer" "Structure") rather than the long winded command layer method. The VLa-add is a good idea as if exists keeps going else adds. It would be a good library defun so only 1 line required in your code.

 

; library defun to check if layer exists
; there would be a acdoc defun also
(defun addlayer (layername / acdoc)
(vla-startundomark
       (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
     )
     (vla-add (vla-get-layers acDoc) layerName )
) ; end defun

; code (addlayer "STRUCTURE")

Link to comment
Share on other sites

Like Black box I would use in the simple code version above (setvar "clayer" "Structure") rather than the long winded command layer method. The VLa-add is a good idea as if exists keeps going else adds. It would be a good library defun so only 1 line required in your code.

 

*Tips hat* - Cheers, dude. :beer:

 

 

 

The only thing I'd add, and this is my $0.02 (take from it what you like) - is to call *UndoMark from the calling routine, rather than within the sub-function(s); just makes more sense for the code I use here, YMMV.

Link to comment
Share on other sites

  • 5 years later...
  • 1 year later...
On 7/15/2015 at 12:29 PM, BlackBox said:

Looks like you guys have been posting since I was pulled into a meeting - but I'll post this anyway. :)

 

This will ensure that the dependent layer is available, handles some misc. entity overrides, supports multiple entity selection, and supports UNDO:

 

 

(defun c:FOO (/ *error* _Offset acDoc layerName left right ss)

 (defun *error* (msg)
   (if ss (vla-delete ss))
   (if acDoc (vla-endundomark acDoc))
   (cond ((not msg))                                                   ; Normal exit
         ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
         ((princ (strcat "\n** Error: " msg " ** ")))                  ; Fatal error, display it
   )
   (princ)
 )

 (defun _Offset (x dir layerName)
   (foreach y (vlax-invoke x 'offset dir)
     (vla-put-color y acbylayer)
     (vla-put-layer y layerName)
     (vla-put-linetype y "bylayer")
   )
 )

 (if (ssget "_:L" '((0 . "ARC,CIRCLE,ELLIPSE,*LINE")))
   (progn
     (vla-startundomark
       (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
     )
     (vla-add (vla-get-layers acDoc) (setq layerName "STRUCTURE"))
     (setq left  0.0812
           right (- 0.0812)
     )
     (vlax-for x (setq ss (vla-get-activeselectionset acDoc))
       (_Offset x left layerName)
       (_Offset x right layerName)
     )
   )
 )

 (*error* nil)
)
 

Is it possible for this routine to prompt a user to pick an offset side of the selected object first? The other side picking up the negative value.

 

 

Cheers

 

Link to comment
Share on other sites

@capnsjules

;; Change this
;;;     (setq left  0.0812
;;;           right (- 0.0812)
;;;     )
;; To this
(setq left  (getdist "\nSpecify offset distance: ")
      right (- left)
)

 

Edited by ronjonp
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...