Jump to content

Multiple Offset Lisp


celiktele

Recommended Posts

Hello to all.

 

I desperetely need a lisp that can offset different objects at the same time. And and color the offseted objects red if they are fit into each other.

I searched the board but couldnt find anything that i can use. I'll be glad if anyone can help.

 

Thanks in advance.

Link to comment
Share on other sites

I understand the offset multiple (separate) objects but I'm not sure what you mean by color the offseted (sic) objects red if they are fit into each other. Do you mean if they overlap each other? Are you checking for interference amongst 2D objects?

Link to comment
Share on other sites

Something like this?

 

(defun c:mOff (/ ss tmp)
 (vl-load-com)
 (or *moff (setq *moff 10.0))

 (if (setq ss (ssget '((0 . "ARC,CIRCLE,ELLIPSE,*LINE"))))
   (progn
     (initget 6)
     (and (setq tmp (getdist (strcat "\nSpecify Offset <" (vl-princ-to-string *moff) "> : ")))
          (setq *moff tmp))

     (mapcar
       (function
         (lambda (x)
           (vla-offset x *moff)
           (vla-offset x (- *moff))))
       (mapcar 'vlax-ename->vla-object
         (vl-remove-if 'listp
           (mapcar 'cadr (ssnamex ss)))))))
 (princ))

Link to comment
Share on other sites

I understand the offset multiple (separate) objects but I'm not sure what you mean by color the offseted (sic) objects red if they are fit into each other. Do you mean if they overlap each other? Are you checking for interference amongst 2D objects?

 

Yes. I want to check if offseted ( :) ) objects overlap. I need this because the objects has to have a specific space between them. I have to correct them if they arent.

 

@Lee Mac; Thanks for your lisp but I forgot to mention, i only need outer offset.And i need something (coloring for example) to notice if the objects overlap with each other.

Link to comment
Share on other sites

Try this:

 

(defun c:mOff (/ ss tmp safe lst)
 (vl-load-com)
 (or *moff (setq *moff 10.0))

 (setq doc (vla-get-ActiveDocument
             (vlax-get-acad-object)))

 (if (setq ss (ssget '((0 . "ARC,CIRCLE,ELLIPSE,*LINE"))))
   (progn
     (initget 6)
     (and (setq tmp (getdist (strcat "\nSpecify Offset <" (vl-princ-to-string *moff) "> : ")))
          (setq *moff tmp))
     (vla-StartUndoMark doc)

     (foreach var (mapcar (function (lambda (x) (vla-offset x *moff)))
                          (mapcar 'vlax-ename->vla-object
                                  (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
       
       (cond ((<= 0 (vlax-safearray-get-u-bound
                     (setq safe (vlax-variant-value var)) 1))
              (setq lst (cons (vlax-safearray->list safe) lst)))))

     (foreach Obj (setq lst (apply 'append lst))

       (if (vl-some
             (function
               (lambda (x)
                 (vlax-invoke obj 'IntersectWith x acExtendNone)))
             (vl-remove Obj lst))
         (vla-put-color Obj acred)))
     (vla-EndUndoMark doc)))
         
 (princ))

Link to comment
Share on other sites

  • 7 years later...

Hi Lee Mac,

 

Great program. I have a request further for your lisp program if you don't mind.

 

is it possible the new line after being offset be changed to the current layer?

 

Thank you, much appreciated

Link to comment
Share on other sites

Hi Lee Mac,

 

Great program. I have a request further for your lisp program if you don't mind.

 

is it possible the new line after being offset be changed to the current layer?

 

Thank you, much appreciated

Link to comment
Share on other sites

  • 4 weeks later...
  • 1 year later...
On 9/30/2009 at 8:04 AM, Lee Mac said:

Try this:

 

 


(defun c:mOff (/ ss tmp safe lst)
 (vl-load-com)
 (or *moff (setq *moff 10.0))

 (setq doc (vla-get-ActiveDocument
             (vlax-get-acad-object)))

 (if (setq ss (ssget '((0 . "ARC,CIRCLE,ELLIPSE,*LINE"))))
   (progn
     (initget 6)
     (and (setq tmp (getdist (strcat "\nSpecify Offset <" (vl-princ-to-string *moff) "> : ")))
          (setq *moff tmp))
     (vla-StartUndoMark doc)

     (foreach var (mapcar (function (lambda (x) (vla-offset x *moff)))
                          (mapcar 'vlax-ename->vla-object
                                  (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
       
       (cond ((<= 0 (vlax-safearray-get-u-bound
                     (setq safe (vlax-variant-value var)) 1))
              (setq lst (cons (vlax-safearray->list safe) lst)))))

     (foreach Obj (setq lst (apply 'append lst))

       (if (vl-some
             (function
               (lambda (x)
                 (vlax-invoke obj 'IntersectWith x acExtendNone)))
             (vl-remove Obj lst))
         (vla-put-color Obj acred)))
     (vla-EndUndoMark doc)))
         
 (princ))
 

Hi, 

i used your lisp and is great, i noticed that if i select multiple objets sometimes the offset is going to outsite and sometimes inside, is there a way to chose the way to do the offset, i mean all outside or all inside??

thanks in advance.

Regards!

 

Link to comment
Share on other sites

On 7/19/2017 at 3:03 PM, argohn said:

Dear I would like to know if the routine can Preserve only the entity outside and delete the original and the interior?

did you get any answer on this?

Link to comment
Share on other sites

  • 1 year later...
(defun c:ois()
  (setq ans (AH:getvalsm (list "OFFSET WITH INSULATION" "Specify insulation thickness " 10 10 (vl-princ-to-string isz) "Specify insulation layer " 25 25 (vl-princ-to-string ilyr))))
  (setq isz (atof (nth 0 ans)))
  (setq ilyr (nth 1 ans))
  (if (= isz 0)(alert "Set insulation thickness"))
  (if (= ilyr"nil")(alert "Set insulation layer"))
  (setq acadObj (vlax-get-acad-object))
  (setq doc (vla-get-ActiveDocument acadObj))
  (setq layers (vla-get-Layers doc))
  (setq ilyrc (vla-Add layers ilyr)))
  

(defun c:oi (/ ss tmp)
 (vl-load-com)
   (if (= ans nil)(c:ois))
  if(if (= isz 0)(c:ois))
  if(if (= ilyr"nil")(c:ois))
  (or *moff (setq *moff 10.0))
  (and (setq tmp (getdist (strcat "\nSpecify pipe size <" (vl-princ-to-string *moff) "> : ")))
       (setq *moff tmp)
       (setq *moffi(/ *moff 2)))
  (while(if (setq ss (ssget '((0 . "ARC,CIRCLE,ELLIPSE,*LINE"))))
   (progn
     (initget 6)
     (setq iszo (+ *moffi isz))
     (mapcar
       (function
         (lambda (x)
           (vla-offset x (+ *moffi))
	   (setq vlobj (vlax-ename->vla-object (entlast)))
	   (vla-put-color vlobj acbylayer)
	   (vla-put-linetype vlobj "Bylayer") 
	   (vla-offset x (+ iszo))
	   (vla-put-layer (vlax-EName->vla-Object (entlast))ilyr)
	   (vla-put-linetype (vlax-EName->vla-Object (entlast))"Bylayer")
	   (setq vlobj (vlax-ename->vla-object (entlast)))
	   (vla-offset x (- *moffi))
	   (setq vlobj (vlax-ename->vla-object (entlast)))
	   (vla-put-color vlobj acbylayer)
	   (vla-put-linetype vlobj "Bylayer")
	   (vla-offset x (- iszo))
	   (vla-put-layer (vlax-EName->vla-Object (entlast))ilyr)
	   (vla-put-linetype (vlax-EName->vla-Object (entlast))"Bylayer")
	   ))
       (mapcar 'vlax-ename->vla-object
         (vl-remove-if 'listp
           (mapcar 'cadr (ssnamex ss))))))))
 (princ))

dear Lee Mac ,

 

i add somethings what i need exactly. but its not coming properly some time

 

 

(when i will select the line color  "252"  but the offset line i need bylayer) so this will be pipe center line will be one color, pipe will be another color, insulation will be an another color, that is what i need

 

Edited by Ajmal
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...