Jump to content

Offset LISP Routine just needs small update. Thanks!


tmelancon

Recommended Posts

Just came across this neat little LISP routine. Works perfect for me and my guys because we insulated pipe and this eliminates having to click click click click to constantly offset lines both ways.

 

(defun C:OFF2  (/ pickEnt pickObj offDist)
(vl-load-com)
(setvar "ErrNo" 0)
(while (and (not (setq pickEnt (entsel))) (/= 52 (getvar "ErrNo"))))
(cond ((and pickEnt
            (setq pickObj (vlax-EName->vla-Object (car pickEnt)))
            (progn (initget 6)
                   (setq offDist (getdist "\nSpecify offset distance: "))))
       (vla-Offset pickObj offDist)
       (vla-Offset pickObj (- offDist))
       (I:PutCL pickObj)))
(princ))

(defun I:PutCL  (myObj / linetypes ltName)
(setq linetypes (vla-Get-Linetypes (vla-Get-Document myObj))
      ltName    "Center")
(cond ((vl-catch-all-error-p
        (vl-catch-all-apply 'vla-Item (list linetypes ltName)))
       (vla-Load linetypes
                 ltName
                 (cond ((= (getvar "Measurement") 0) "Acad.lin")
                       ("AcadISO.lin")))))
(vla-Put-Linetype myObj ltName))

 

Question: Can someone have a look and instead of prompting for offset distance (since we already have a standard set distance ALWAYS) of 0.812 so thats what I would need. Also can someone add a for multiple piece?

 

 

God bless!

Link to comment
Share on other sites

hi tmelancon, this quick modify for single click,

can you explain M for other selection? or repeating for the same entity?

(defun C:OFF2 (/ pickEnt pickObj offDist)
 (vl-load-com)
[color="red"] (setq offDist(ureal 6 "" "\nSpecify offset distance: " 0.812))[/color]
 (while (setq pickEnt (entsel))
   (cond ((and pickEnt (setq pickObj (vlax-EName->vla-Object (car pickEnt))) offDist)
   (vla-Offset pickObj offDist)
   (vla-Offset pickObj (- offDist))
   (I:PutCL pickObj)
   )
  ) ;_ end of cond
   ) ;_ end of while
 (princ)
 ) ;_ end of defun

(defun I:PutCL (myObj / linetypes ltName)
 (setq	linetypes (vla-Get-Linetypes (vla-Get-Document myObj))
ltName	  "Center"
) ;_ end of setq
 (cond	((vl-catch-all-error-p (vl-catch-all-apply 'vla-Item (list linetypes ltName)))
 (vla-Load linetypes
	   ltName
	   (cond ((= (getvar "Measurement") 0) "Acad.lin")
		 ("AcadISO.lin")
		 ) ;_ end of cond
	   ) ;_ end of vla-Load
 )
) ;_ end of cond
 (vla-Put-Linetype myObj ltName)
 ) ;_ end of defun

;;;-------------------------------------------------------------------
;; This function is freeware courtesy of the author's of "Inside AutoLisp"
;; for rel. 10 published by New Riders Publications.  This credit must
;; accompany all copies of this function.
;;* UKWORD User key word. DEF, if any, must match one of the KWD strings
;;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as
;;* for INITGET. MSG is the prompt string, to which a default string is added
;;* as <DEF> (nil or "" for none), and a : is added.
(defun UREAL (bit kwd msg def / inp)
 (if def
   (setq msg (strcat "\n" msg " <" (rtos def 2) "> : ")
         bit (* 2 (fix (/ bit 2)))
         )
   (setq msg (strcat "\n" msg " : "))
   )                                   ;if
 (initget bit kwd)
 (setq inp (getdist msg))
 (if inp inp def)
 )   


Edited by hanhphuc
(setq OffDist...)
Link to comment
Share on other sites

Hey sorry, I was busy this morning and didnt quite word it that well. I am looking for the offset multiple to be included somewhere in there to give the user the option of just offsetting a single line then ending the routine, or type for multiple line selections. Hope this helps!

Link to comment
Share on other sites

If you are starting this lisp from a button you can simply add an asterisks before the command as such...

 

*^C^C(if (not c:OFF2)(load"OFF2")) OFF2;

 

This assumes that the lisp is in one of your support directories and is named OFF2.

 

Cheers.

Link to comment
Share on other sites

Hmm its prompting for user to hit enter/spacebar to initiate the 0.0812 for the actual distance. I tried adding "" to the back of the dist and its stating too many arguments. I was just trying to add it so it hits enter automatically and just prompts for line selection.. :( why is it arguing with me

Link to comment
Share on other sites

Would it be possible just as we are specifying line type, if we could do the same with layer.. Like put it on a specified layer of choice? The two offset lines?

Link to comment
Share on other sites

Would it be possible just as we are specifying line type, if we could do the same with layer.. Like put it on a specified layer of choice? The two offset lines?

 

yes we can modify the code, but you make sure remarking courtesy to the author of original code, credit to his ideas or notify him.

 

this example: i use (getvar "clayer") current layer


;;;http://www.cadtutor.net/forum/showthread.php?88082-Offset-LISP-Routine-just-needs-small-update.-Thanks!
(if (not [color="red"]*offDist*[/color])
 (setq *offDist* 0.812)
 ) ;_ end of if
(defun C:OFF2 (/ pickEnt pickObj offDist ss)
 (vl-load-com)
 (setvar "ErrNo" 0)
 (setq offDist (ureal 6 "Multiple" "\nSpecify offset distance or [Multiple] : " *offDist*)) ; _ end of
; setq
 (if (= offDist "Multiple")
   (progn (setq offDist   (ureal 6 "" "\nSpecify offset distance: " *offDist*)
	 *offDist* offDist
	 ) ;_ end of setq
   (prompt "\nSelect object.. ")
   (setq ss (ssget))
   (foreach en (vl-remove-if ''((x) (listp x)) (mapcar 'cadr (ssnamex ss))) ;_ end of vl-remove-if
     ([color="blue"]offset2: [/color]en offDist [color="red"](getvar "clayer")[/color])
     ) ;_ end of foreach
   ) ;_ end of progn
   (while (setq pickEnt (entsel))
     ([color="blue"]offset2:[/color] (car pickEnt) offDist [color="red"](getvar "clayer")[/color])
     (setq *offDist* offDist)
     ) ; _ end of
; while
   ) ;_ end of if
 (princ)
 ) ;_ end of defun

; modified by hanhphuc* 09/08/2014
(defun [color="blue"]offset2:[/color]	(e off lay / obj)
 (if (and e
   off
   (= (type lay) 'STR)
   (tblsearch "Layer" lay)
   (member (vla-get-objectname (setq obj (vlax-EName->vla-Object e)))
	   '("AcDbCircle" "AcDbArc" "AcDbPolyline" "AcDbLine" "AcDbEllipse" "AcDbSpline")
	   ) ;_ end of member
   ) ;_ end of and
   (progn (foreach o (list (vla-Offset obj off) (vla-Offset obj (- off)))
     (vla-put-layer (car (vlax-safearray->list (vlax-variant-value o))) lay)
     ) ;_ end of foreach
   (I:PutCL obj)
   ) ;_ end of progn
   ) ;_ end of if
 ) ;_ end of defun

(defun I:PutCL (myObj / linetypes ltName)
 (setq	linetypes (vla-Get-Linetypes (vla-Get-Document myObj))
ltName	  "Center"
) ;_ end of setq
 (cond	((vl-catch-all-error-p (vl-catch-all-apply 'vla-Item (list linetypes ltName)))
 (vla-Load linetypes
	   ltName
	   (cond ((= (getvar "Measurement") 0) "Acad.lin")
		 ("AcadISO.lin")
		 ) ;_ end of cond
	   ) ;_ end of vla-Load
 )
) ;_ end of cond
 (vla-Put-Linetype myObj ltName)
 ) ;_ end of defun



;;;-------------------------------------------------------------------
;; This function is freeware courtesy of the author's of "Inside AutoLisp"
;; for rel. 10 published by New Riders Publications.  This credit must
;; accompany all copies of this function.
;;* UKWORD User key word. DEF, if any, must match one of the KWD strings
;;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as
;;* for INITGET. MSG is the prompt string, to which a default string is added
;;* as <DEF> (nil or "" for none), and a : is added.
(defun UREAL (bit kwd msg def / inp)
 (if def
   (setq msg (strcat "\n" msg " <" (rtos def 2) "> : ")
         bit (* 2 (fix (/ bit 2)))
         )
   (setq msg (strcat "\n" msg " : "))
   )                                   ;if
 (initget bit kwd)
 (setq inp (getdist msg))
 (if inp inp def)
 )   

For [multiple], key-in M -> then key-in offset distance -> select multuple objects

Edited by hanhphuc
*offset* is global variable
Link to comment
Share on other sites

2 suggestions you can wrap the routine in a While that is keep picking objects the moment you pick nothing, space on screen, it exits 1 pick is ok or as many as you want easier than "M". 2nd its probaly easier again to preset the offset and have a prompt using Enter to accept or type a new value it would ask this only once at start for multiple, if different value required multiple then yes exit do again save some accept steps. Same for layer. The posters above may consider incorporating these ideas into their code.

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