Jump to content

inside offset multiple

exceed

By exceed
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

exceed Proficient

exceed

Posted
Posted (edited) 
;; inside offset multiple - 2022.04.19 exceed
;; save your drawing. before run this lisp.
;; select object which can offset inside.
;; complex shape will make error. in this case have to run this twice.

(vl-load-com)

(defun c:flh ( / offdis ss ssl index ent entname obj )
 (setq offdis (getdist "\n Input Offset Value = "))
 (princ "\n Select Object = ")
 (setq ss (ssget)) 
 (setq ssl (sslength ss))
 (setq index 0)
 (repeat ssl 
   (setq ent (entget (ssname ss index)))
   (setq entname (cdr (assoc -1 ent)))
   (setq obj (vlax-ename->vla-object entname))
   (ex_flh obj offdis)

   (setq index (+ index 1))
 )
 (princ)
)

(defun ex_flh ( obj offdis ) ;/ subloop1 subloop2 subloop1length subloop2length )
   (vla-offset obj (* offdis 1))
   (setq subloop1 (vlax-ename->vla-object (entlast)))
   (vla-offset obj (* offdis -1))
   (setq subloop2 (vlax-ename->vla-object (entlast)))

   (setq subloop1type (vlax-get-property subloop1 'entityname))
   ;(princ subloop1type)

   (setq subloop2type (vlax-get-property subloop2 'entityname))
   ;(princ "\n")
   ;(princ subloop2type)
   (cond 
     ((= subloop1type "AcDbPolyline")
      (setq subloop1length (vlax-get-property subloop1 'length))
     )
     ((= subloop1type "AcDbCircle")
      (setq subloop1length (vlax-get-property subloop1 'Circumference))
     )
     ((= subloop1type "AcDbArc")
      (setq subloop1length (vlax-get-property subloop1 'Radius))
     )

   );end of cond
   (cond 
     ((= subloop2type "AcDbPolyline")
      (setq subloop2length (vlax-get-property subloop2 'length))
     )
     ((= subloop2type "AcDbCircle")
      (setq subloop2length (vlax-get-property subloop2 'Circumference))
     )
     ((= subloop2type "AcDbArc")
      (setq subloop2length (vlax-get-property subloop2 'Radius))
     )
   );end of cond
      

   (cond
      ((> subloop1length subloop2length) (progn (vla-delete subloop1) (setq looplength subloop2length) (setq obj subloop2)))      
      ((< subloop1length subloop2length) (progn (vla-delete subloop2) (setq looplength subloop1length) (setq obj subloop1)))
      ((= subloop1length subloop2length) (progn (vla-delete subloop2) (setq looplength subloop1length) (setq obj subloop1)))
   )

   (setq objtype (vlax-get-property obj 'entityname))

   (cond
     ((= objtype "AcDbPolyline")
      (progn
      (setq segmentlength '())
      (setq startsegment (vlax-curve-getStartParam obj))
      (setq endsegment (vlax-curve-getEndParam obj))
      (while (< startsegment endsegment)
        (setq segmentlength (append segmentlength (list (- (vlax-curve-getDistAtParam obj (setq startsegment (1+ startsegment))) (vlax-curve-getDistAtParam obj (1- startsegment))))))
      )
      ;(princ "\n segmentlength - ")
      ;(princ segmentlength)
      (setq minseg (nth 2 (vl-sort segmentlength '>)))
      (if (> minseg (* offdis 3))
        (progn (ex_flh obj offdis))
        (progn (princ "\n not enough space "))
      );end of if
     );end of progn
    ); end of cond case 1
     ((= objtype "AcDbCircle")
      (progn
       (setq basecircumference (* (* 3 pi) offdis))
       (if (> looplength basecircumference)
        (progn (ex_flh obj offdis))
        (progn (princ "\n not enough space "))
       );end of if
      );end of progn
     ); end of cond case 2
     ((= objtype "AcDbArc")
      (progn
       (setq baseradius (* 1.5 offdis))
       (if (> looplength baseradius)
        (progn (ex_flh obj offdis))
        (progn (princ "\n not enough space "))
       );end of if
      );end of progn
     ); end of cond case 3
   );end of cond
)
   (princ "\n loading complete")

 

2022-04-19 10;25;52.gif

 

2022-04-19 11;06;42.gif

 

command : FLH

experimental lisp. for my study 

 

offset executed in both directions, 

the shorter length is inward, and the longer one is outside = delete. 

 

will stop 

if an appropriate offset value is not entered or if a complex shape is selected. 

 

determine whether it can be further offset by the segment length, 

ex) If the segment length of the created loop is 3, Lisp determines that it can offset 1 on both sides.

If not possible, print 'not enough space' and move to the next object. 

 

a general shape such as a rectangle or Tetris shape is fine as I tested.

but an offset error may occur if the segment length cannot be determined such as that of a flower shape. 

In that case, just loop stops, so can run it again from within.

 

 

It would be nice to have a function to +1 to the index variable, 

move on to the next when an offset error occurs like error control. not judged by segment length. 

 

If you have any better Lisp or ideas for this, please let me know.😀

 

 

+

another way to improve this is to find the offset center points (this point can be multiple) 

based on these shapes made from outside to inside based on this value, 

and then offset from inside to outside again. 

ex) if there is 6, offset by 1 to reach 6->4->2, (this lisp)

and find the center point of 2, and offset 1->3->5 again. 

 

rflh.gif

like this

command : RFLH

 

This is more unstable. 

;; reverse inside offset multiple - 2022.04.19 exceed
;; save your drawing. before run this lisp.
;; select object which can offset inside.
;; complex shape will make error. in this case have to run this twice.

(vl-load-com)

(defun c:rflh ( / offdis ss ssl index ent entname obj )
 (setq offdis (getdist "\n Input Offset Value = "))
 (princ "\n Select Object = ")
 (setq ss (ssget)) 
 (setq ssl (sslength ss))
 (setq index 0)
 (setq ss2 (ssadd))
 (repeat ssl 
   (setq ent (entget (ssname ss index)))
   (setq entname (cdr (assoc -1 ent)))
   (setq obj (vlax-ename->vla-object entname))
   (setq looplength 0)
   (setq minseg 0)
   (setq delta 0)
   (ex_flh obj offdis)

   (setq index (+ index 1))
   (setq ss2 (ssadd))
 )
 (princ)
)

(defun ex_flh ( obj offdis ) ;/ subloop1 subloop2 subloop1length subloop2length )
   (vla-offset obj (* offdis 1))
   (setq subloop1 (vlax-ename->vla-object (entlast)))
   (vla-offset obj (* offdis -1))
   (setq subloop2 (vlax-ename->vla-object (entlast)))

   (setq subloop1type (vlax-get-property subloop1 'entityname))
   ;(princ subloop1type)

   (setq subloop2type (vlax-get-property subloop2 'entityname))
   ;(princ "\n")
   ;(princ subloop2type)
   (cond 
     ((= subloop1type "AcDbPolyline")
      (setq subloop1length (vlax-get-property subloop1 'length))
     )
     ((= subloop1type "AcDbCircle")
      (setq subloop1length (vlax-get-property subloop1 'Radius))
     )
     ((= subloop1type "AcDbArc")
      (setq subloop1length (vlax-get-property subloop1 'Radius))
     )

   );end of cond
   (cond 
     ((= subloop2type "AcDbPolyline")
      (setq subloop2length (vlax-get-property subloop2 'length))
     )
     ((= subloop2type "AcDbCircle")
      (setq subloop2length (vlax-get-property subloop2 'Radius))
     )
     ((= subloop2type "AcDbArc")
      (setq subloop2length (vlax-get-property subloop2 'Radius))
     )
   );end of cond
      

   (cond
      ((> subloop1length subloop2length) (progn (vla-delete subloop1) (setq looplength subloop2length) (setq obj subloop2)))      
      ((< subloop1length subloop2length) (progn (vla-delete subloop2) (setq looplength subloop1length) (setq obj subloop1)))
      ((= subloop1length subloop2length) (progn (vla-delete subloop2) (setq looplength subloop1length) (setq obj subloop1)))
   )

   
   (ssadd (vlax-vla-object->ename obj) ss2)

   (setq objtype (vlax-get-property obj 'entityname))

   (cond
     ((= objtype "AcDbPolyline")
      (progn
      (setq segmentlength '())
      (setq startsegment (vlax-curve-getStartParam obj))
      (setq endsegment (vlax-curve-getEndParam obj))
      (while (< startsegment endsegment)
        (setq segmentlength (append segmentlength (list (- (vlax-curve-getDistAtParam obj (setq startsegment (1+ startsegment))) (vlax-curve-getDistAtParam obj (1- startsegment))))))
      )
      ;(princ "\n segmentlength - ")
      ;(princ segmentlength)
      (setq minseg (nth 3 (vl-sort segmentlength '>)))
      (cond
        ((> minseg (* offdis 3))
          (progn (ex_flh obj offdis))
        ); end of cond case 1
        ((< minseg (* offdis 3))
          (progn 
                 (repeat (sslength ss2)
                   (setq obj2 (ssname ss2 0))
                   (entdel obj2)
                   (ssdel obj2 ss2)
                 )
	     (setq ss2 (ssadd))
                 (princ "\n make it reverse ")
                 (setq answer (getstring "\n proceed?"))
                 (setq obj (vlax-ename->vla-object entname))
                 (setq delta (/ (- (* offdis 3) minseg) 2))
                 (vla-offset obj (* (- offdis delta) 1))
                 (setq subloop1 (vlax-ename->vla-object (entlast)))
                 (vla-offset obj (* (- offdis delta) -1))
                 (setq subloop2 (vlax-ename->vla-object (entlast)))
	     (setq subloop1length (vlax-get-property subloop1 'length))
                 (setq subloop2length (vlax-get-property subloop2 'length))
                 (cond
                   ((> subloop1length subloop2length) (progn (vla-delete subloop1) (setq looplength subloop2length) (setq obj subloop2)))      
                   ((< subloop1length subloop2length) (progn (vla-delete subloop2) (setq looplength subloop1length) (setq obj subloop1)))
                   ((= subloop1length subloop2length) (progn (vla-delete subloop2) (setq looplength subloop1length) (setq obj subloop1)))
                 )
                 (ex_flh obj offdis)
         ); end of progn
         ); end of cond case2
         ((= minseg (* offdis 3))
            (progn
                  (vla-offset obj (* offdis 1))
                  (setq subloop1 (vlax-ename->vla-object (entlast)))
                  (vla-offset obj (* offdis -1))
                  (setq subloop2 (vlax-ename->vla-object (entlast)))
	      (setq subloop1length (vlax-get-property subloop1 'length))
                  (setq subloop2length (vlax-get-property subloop2 'length))
                  (cond
                    ((> subloop1length subloop2length) (progn (vla-delete subloop1) (setq looplength subloop2length) (setq obj subloop2)))      
                    ((< subloop1length subloop2length) (progn (vla-delete subloop2) (setq looplength subloop1length) (setq obj subloop1)))
                    ((= subloop1length subloop2length) (progn (vla-delete subloop2) (setq looplength subloop1length) (setq obj subloop1)))
                  )
               (princ "\n complete ") 
             );end of progn
         ); end of cond case3
      );end of cond
     );end of progn
    ); end of cond case 1
     ((= objtype "AcDbCircle")
      (progn
       (cond
        ((> looplength (* offdis 1.5))
         (progn (ex_flh obj offdis))
        );end of cond case 1
        ((< looplength (* offdis 1.5))
         (progn
                 (repeat (sslength ss2)
                   (setq obj2 (ssname ss2 0))
                   (entdel obj2)
                   (ssdel obj2 ss2)
                 )
	     (setq ss2 (ssadd))
                 (princ "\n make it reverse ")
                 (setq answer (getstring "\n proceed?"))
                 (setq obj (vlax-ename->vla-object entname))
                 (setq delta (- (* offdis 1.5) looplength))
                 (vla-offset obj (* (- offdis delta) 1))
                 (setq subloop1 (vlax-ename->vla-object (entlast)))
                 (vla-offset obj (* (- offdis delta) -1))
                 (setq subloop2 (vlax-ename->vla-object (entlast)))
	     (setq subloop1length (vlax-get-property subloop1 'radius))
                 (setq subloop2length (vlax-get-property subloop2 'radius))
                 (cond
                   ((> subloop1length subloop2length) (progn (vla-delete subloop1) (setq looplength subloop2length) (setq obj subloop2)))      
                   ((< subloop1length subloop2length) (progn (vla-delete subloop2) (setq looplength subloop1length) (setq obj subloop1)))
                   ((= subloop1length subloop2length) (progn (vla-delete subloop2) (setq looplength subloop1length) (setq obj subloop1)))
                 )
                 (ex_flh obj offdis)
         );end of progn
         );end of cond case 2
         ((= looplength (* offdis 1.5))
            (progn
                  (vla-offset obj (* offdis 1))
                  (setq subloop1 (vlax-ename->vla-object (entlast)))
                  (vla-offset obj (* offdis -1))
                  (setq subloop2 (vlax-ename->vla-object (entlast)))
	      (setq subloop1length (vlax-get-property subloop1 'radius))
                  (setq subloop2length (vlax-get-property subloop2 'radius))
                  (cond
                    ((> subloop1length subloop2length) (progn (vla-delete subloop1) (setq looplength subloop2length) (setq obj subloop2)))      
                    ((< subloop1length subloop2length) (progn (vla-delete subloop2) (setq looplength subloop1length) (setq obj subloop1)))
                    ((= subloop1length subloop2length) (progn (vla-delete subloop2) (setq looplength subloop1length) (setq obj subloop1)))
                  )
               (princ "\n complete ") 
             );end of progn
         ); end of cond case3
       );end of cond
      );end of progn
     ); end of cond case 2
     ((= objtype "AcDbArc")
      (progn
       (cond
        ((> looplength (* offdis 1.5))
         (progn (ex_flh obj offdis))
        );end of cond case 1
        ((< looplength (* offdis 1.5))
         (progn
                 (repeat (sslength ss2)
                   (setq obj2 (ssname ss2 0))
                   (entdel obj2)
                   (ssdel obj2 ss2)
                 )
	     (setq ss2 (ssadd))
                 (princ "\n make it reverse ")
                 (setq answer (getstring "\n proceed?"))
                 (setq obj (vlax-ename->vla-object entname))
                 (setq delta (- (* offdis 1.5) looplength))
                 (vla-offset obj (* (- offdis delta) 1))
                 (setq subloop1 (vlax-ename->vla-object (entlast)))
                 (vla-offset obj (* (- offdis delta) -1))
                 (setq subloop2 (vlax-ename->vla-object (entlast)))
	     (setq subloop1length (vlax-get-property subloop1 'radius))
                 (setq subloop2length (vlax-get-property subloop2 'radius))
                 (cond
                   ((> subloop1length subloop2length) (progn (vla-delete subloop1) (setq looplength subloop2length) (setq obj subloop2)))      
                   ((< subloop1length subloop2length) (progn (vla-delete subloop2) (setq looplength subloop1length) (setq obj subloop1)))
                   ((= subloop1length subloop2length) (progn (vla-delete subloop2) (setq looplength subloop1length) (setq obj subloop1)))
                 )
                 (ex_flh obj offdis)
         );end of progn
         );end of cond case 2
         ((= looplength (* offdis 1.5))
            (progn
                  (vla-offset obj (* offdis 1))
                  (setq subloop1 (vlax-ename->vla-object (entlast)))
                  (vla-offset obj (* offdis -1))
                  (setq subloop2 (vlax-ename->vla-object (entlast)))
	      (setq subloop1length (vlax-get-property subloop1 'radius))
                  (setq subloop2length (vlax-get-property subloop2 'radius))
                  (cond
                    ((> subloop1length subloop2length) (progn (vla-delete subloop1) (setq looplength subloop2length) (setq obj subloop2)))      
                    ((< subloop1length subloop2length) (progn (vla-delete subloop2) (setq looplength subloop1length) (setq obj subloop1)))
                    ((= subloop1length subloop2length) (progn (vla-delete subloop2) (setq looplength subloop1length) (setq obj subloop1)))
                  )
               (princ "\n complete ") 
             );end of progn
         ); end of cond case3
       );end of cond
      );end of progn
     ); end of cond case 3
   );end of cond
)
   (princ "\n loading complete")

 

Edited by exceed
add case of arc

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