Jump to content

Offset multiple objects at once inside

Juergen

By Juergen
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Juergen Enthusiast

Juergen

Posted
Posted

Hi everybody!
I have several different closed polylines that i have to offset
inside with the same distance (query which distance) so long until this is no longer possible.
Can someone please help me to automate this?
Example file in the appendix.

 

Thank you for your help.

offset.dwg

BIGAL Grand Master

BIGAL

Posted
Posted

need a check for "Cannot offset that object." I am sure there is some sort of distance parameter longest side etc needs more thought.

Roy_043 Mentor

Roy_043

Posted
Posted

Try: 

(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
    )
  )
)

(defun KGA_Sys_Apply (expr varLst / ret)
  (if (not (vl-catch-all-error-p (setq ret (vl-catch-all-apply expr varLst))))
    ret
  )
)

(defun c:OffsetFill ( / _Offset dis doc newLst ss)

  (defun _Offset (obj dis)
    (foreach obj (KGA_Sys_Apply 'vlax-invoke (list obj 'offset dis))
      (_Offset obj dis)
    )
  )

  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if
    (and
      (setq ss (ssget "_:L" '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
      (or
        *OffsetFill_dis*
        (setq *OffsetFill_dis* 1.0)
      )
      (setq *OffsetFill_dis*
        (cond
          ((getdist (strcat "\nOffset distance <" (rtos *OffsetFill_dis*) ">: ")))
          (*OffsetFill_dis*)
        )
      )
      (setq dis *OffsetFill_dis*)
    )
    (foreach obj (KGA_Conv_Pickset_To_ObjectList ss)
      (setq newLst (KGA_Sys_Apply 'vlax-invoke (list obj 'offset dis)))
      ; Verify sign of dis:
      (if
        (vl-some
          '(lambda (new) (> (vla-get-area new) (vla-get-area obj)))
          newLst
        )
        (progn
          (mapcar 'vla-delete newLst)
          (setq dis (- dis))
          (setq newLst (KGA_Sys_Apply 'vlax-invoke (list obj 'offset dis)))
        )
      )
      (foreach obj newLst
        (_Offset obj dis)
      )
    )
  )
  (vla-endundomark doc)
  (princ)
)

 

ronjonp Grand Master

ronjonp

Posted
Posted (edited)

Another for fun:
  

(defun c:foo (/ _off a b d i n o o1 o2 s)
  ;; RJP » 2018-11-29
  (defun _off (o d / r)
    (cond ((= 'list (type (setq r (vl-catch-all-apply 'vlax-invoke (list o 'offset d))))) (car r)))
  )
  (or (setq i (getenv "RJP_Offset_Dist")) (setq i "1"))
  (setq b (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
  (cond
    ((and (setq	i (cond	((getdist (strcat "\nEnter Offset Distance: <" i ">: ")))
			((atof i))
		  )
	  )
	  (setq s (setq ss (ssget "_:L" '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1)))))
     )
     (setenv "RJP_Offset_Dist" (vl-princ-to-string i))
     (setq b (vlax-get (vla-item b (getvar 'clayer)) 'lock))
     (foreach e	(vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
       (cond ((and (setq o1 (_off (setq o (vlax-ename->vla-object e)) i)) (setq o2 (_off o (- i))))
	      (setq n (cond ((> (vlax-curve-getarea o1) (vlax-curve-getarea o2)) -)
			    (+)
		      )
	      )
	      (mapcar 'vla-delete (list o1 o2))
	      (while (setq a (_off o (n i)))
		(setq o a)
		(and (= 0 b) (vla-put-layer o (getvar 'clayer)))
	      )
	     )
       )
     )
    )
  )
  (princ)
)
(vl-load-com)

 

Edited by ronjonp
Juergen Enthusiast

Juergen

Posted
  • Author
Posted

Hi Guys!

 

Thank you for taking the time
to support my post.
Both programs are great.
Exactly what I need.

 

Thx.

Jürgen

Juergen Enthusiast

Juergen

Posted
  • Author
Posted

Hi Guys!
I still have a little something.
Is it possible that the offsetlines
to be offset with the current layer?

 

Thx.

Roy_043 Mentor

Roy_043

Posted
Posted (edited)

Version that puts the new entities on the current layer: 

(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
    )
  )
)

(defun KGA_Sys_Apply (expr varLst / ret)
  (if (not (vl-catch-all-error-p (setq ret (vl-catch-all-apply expr varLst))))
    ret
  )
)

(defun c:OffsetFill ( / _Offset dis doc newLst ss)

  (defun _Offset (obj dis)
    (foreach obj (KGA_Sys_Apply 'vlax-invoke (list obj 'offset dis))
      (_Offset obj dis)
    )
  )

  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if
    (and
      (setq ss (ssget "_:L" '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
      (or
        *OffsetFill_dis*
        (setq *OffsetFill_dis* 1.0)
      )
      (setq *OffsetFill_dis*
        (cond
          ((getdist (strcat "\nOffset distance <" (rtos *OffsetFill_dis*) ">: ")))
          (*OffsetFill_dis*)
        )
      )
      (setq dis *OffsetFill_dis*)
    )
    (foreach obj (KGA_Conv_Pickset_To_ObjectList ss)
      (setq newLst (KGA_Sys_Apply 'vlax-invoke (list obj 'offset dis)))
      ; Verify sign of dis:
      (if
        (vl-some
          '(lambda (new) (> (vla-get-area new) (vla-get-area obj)))
          newLst
        )
        (progn
          (mapcar 'vla-delete newLst)
          (setq dis (- dis))
          (setq newLst (KGA_Sys_Apply 'vlax-invoke (list obj 'offset dis)))
        )
      )
      (foreach obj newLst
        (vla-put-layer obj (getvar 'clayer))
        (_Offset obj dis)
      )
    )
  )
  (vla-endundomark doc)
  (princ)
)

 

Edited by Roy_043
Juergen Enthusiast

Juergen

Posted
  • Author
Posted

Hi Roy,

 

one short code line 😉

 

Thank you again.

Roy_043 Mentor

Roy_043

Posted
Posted

@ronjonp: If the polyline is not convex the Offset method can create more than one new entity.

ronjonp Grand Master

ronjonp

Posted
Posted
4 hours ago, Roy_043 said:

@ronjonp: If the polyline is not convex the Offset method can create more than one new entity.

@Roy_043 Definitely :). We should also check that the current layer is not locked or it will chuck a wobbly. Code updated above to put items on current layer.

Roy_043 Mentor

Roy_043

Posted
Posted

@ronjonp

AFAIK the source entity's layer should not be locked. When you assign a new layer to entities it doesn't matter if that layer is locked.

ronjonp Grand Master

ronjonp

Posted
Posted (edited) 
(defun c:foo (/ _off a b d i n o o1 o2 s)
  ;; RJP » 2018-11-30
  (defun _off (o d / r)
    (cond ((= 'list (type (setq r (vl-catch-all-apply 'vlax-invoke (list o 'offset d))))) (car r)))
  )
  (or (setq i (getenv "RJP_Offset_Dist")) (setq i "1"))
  (setq	i (cond	((getdist (strcat "\nEnter Offset Distance: <" i ">: ")))
		((atof i))
	  )
  )
  (cond
    ((setq s (setq ss (ssget "_:L" '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1)))))
     (setenv "RJP_Offset_Dist" (vl-princ-to-string i))
     (foreach e	(vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
       (cond ((and (setq o1 (_off (setq o (vlax-ename->vla-object e)) i)) (setq o2 (_off o (- i))))
	      (setq n (cond ((> (vlax-curve-getarea o1) (vlax-curve-getarea o2)) -)
			    (+)
		      )
	      )
	      (mapcar 'vla-delete (list o1 o2))
	      (while (setq a (_off o (n i))) (setq b (cons a b)) (setq o a))
	     )
       )
     )
     (foreach x b (vla-put-layer x (getvar 'clayer)))
    )
  )
  (princ)
)
(vl-load-com)

 

image.png

Edited by ronjonp
Roy_043 Mentor

Roy_043

Posted
Posted (edited)

Ah yes, of course. The first new entity becomes the source for the next step and therefore cannot be put on a locked layer.

 

This version should fix that: 

(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
    )
  )
)

(defun KGA_Sys_Apply (expr varLst / ret)
  (if (not (vl-catch-all-error-p (setq ret (vl-catch-all-apply expr varLst))))
    ret
  )
)

(defun c:OffsetFill ( / _Offset dis doc newLst ss)

  (defun _Offset (obj dis)
    (foreach obj (KGA_Sys_Apply 'vlax-invoke (list obj 'offset dis))
      (_Offset obj dis)
      (vla-put-layer obj (getvar 'clayer)) ; Do this last to avoid issue with locked current layer.
    )
  )

  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if
    (and
      (setq ss (ssget "_:L" '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
      (or
        *OffsetFill_dis*
        (setq *OffsetFill_dis* 1.0)
      )
      (setq *OffsetFill_dis*
        (cond
          ((getdist (strcat "\nOffset distance <" (rtos *OffsetFill_dis*) ">: ")))
          (*OffsetFill_dis*)
        )
      )
      (setq dis *OffsetFill_dis*)
    )
    (foreach obj (KGA_Conv_Pickset_To_ObjectList ss)
      (setq newLst (KGA_Sys_Apply 'vlax-invoke (list obj 'offset dis)))
      ; Verify sign of dis:
      (if
        (vl-some
          '(lambda (new) (> (vla-get-area new) (vla-get-area obj)))
          newLst
        )
        (progn
          (mapcar 'vla-delete newLst)
          (setq dis (- dis))
          (setq newLst (KGA_Sys_Apply 'vlax-invoke (list obj 'offset dis)))
        )
      )
      (foreach obj newLst
        (_Offset obj dis)
        (vla-put-layer obj (getvar 'clayer)) ; Do this last to avoid issue with locked current layer.
      )
    )
  )
  (vla-endundomark doc)
  (princ)
)

 

Edited by Roy_043

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.

×
 Share
Go to topic listing
×
×
  • Create New...