An offset Marco for CNC Plasma cutting process!

May 31, 2022

1 hour ago, ronjonp said:

Maybe something can be used from THIS post. Just checks areas to determine inside or out.

Nice, you are dong some magic in there which I couldn't workout just then, the OP wants the outer to offset outside and the inner objects to offset inwards - is that an easy change?

May 31, 2022

1 hour ago, Steven P said:

Nice, you are dong some magic in there which I couldn't workout just then, the OP wants the outer to offset outside and the inner objects to offset inwards - is that an easy change?

Probably, if the outerpolyline is always outside and the inner circles are always inside should be easy peasy

May 31, 2022

'Sometimes' not he says, but should still be easy peasy to get inside and outside to go the opposite way around with an option in or out I guess?

June 3, 2022

On 5/31/2022 at 9:49 AM, exceed said:

; CNC - 2022.05.31 exceed
; https://www.cadtutor.net/forum/topic/75276-an-offset-marco-for-cnc-plasma-cutting-process/
;
; Works on closed polylines, circles.
; Objects with the largest area are offset outward, others are offset inward.
;
; Command List
; CNC - do offset
; @Q - Save and close all opened drawings. Dialogs do not appear individually when closing each drawing. Appears only once for confirmation.
; 
; The color is designated as number 3 (green). The layer does not change.
;
; When you add this Lisp to your starter set, it will work automatically every time you open a drawing.
; Open multiple drawings and save and close them all with the @Q command.
; If you want to manually, add ; in front of (c:CNC) to make ;(c:CNC), 
; it will work when manually entering CNC
;
; Note
; If you reopen a drawing that has already been executed and saved, it will be created again. 
; In this part, it seems to be necessary to add a statement that does not execute if there is a green object in the drawing.
; Your green looks different than mine, so I didn't add this code.


(vl-load-com)
(defun c:CNC ( / offsetvalue ss ssl index arealist obj objarea objlist outerloopobj outeroffset otherloop otherlooplen index2 otherloopobj inneroffset )

  ;(setq offsetvalue 10)
  (setq offsetvalue (getreal "\n Input offset value : "))
  (if (= offsetvalue nil) (progn (princ "\n you cancel CNC offset command") (exit)) )
 
  (setvar 'cmdecho 0)
  (command "_Join" "all" "")
  (setvar 'cmdecho 1)

  (setq ss (ssget "X" '((0 . "LWPOLYLINE,CIRCLE"))))
  (setq ssl (sslength ss))
  (setq index 0)
  (setq arealist '())
  (repeat ssl
    (setq obj (vlax-ename->vla-object (ssname ss index)))
    (setq objarea (vla-get-area obj))
    (setq objlist (list obj objarea))
    (setq arealist (cons objlist arealist))
    (setq index (+ index 1))
  )
  (setq arealist (vl-sort arealist (function (lambda (x1 x2) (> (cadr x1) (cadr x2)) ) )))
  
  (setq outerloopobj (car (car arealist)))
  (setq outeroffset (ex:offsetout outerloopobj offsetvalue))
  (vlax-put-property outeroffset 'color 3)

  (setq otherloop (cdr arealist))
  (setq otherlooplen (length otherloop))
  (setq index2 0)

  (repeat otherlooplen
    (setq otherloopobj (car (nth index2 otherloop)))
    (setq inneroffset (ex:offsetin otherloopobj offsetvalue))
    (vlax-put-property inneroffset 'color 3)
    (setq index2 (+ index2 1))
  )
  

  (princ)
)
 


(defun ex:offsetin ( obj offdis / subloop1 subloop2 subloop1type subloop2type subloop1length subloop2length objloop)
   (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))
   (setq subloop2type (vlax-get-property subloop2 'entityname))
   (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 objloop subloop2)))      
      ((< subloop1length subloop2length) (progn (vla-delete subloop2) (setq looplength subloop1length) (setq objloop subloop1)))
      ((= subloop1length subloop2length) (progn (vla-delete subloop2) (setq looplength subloop1length) (setq objloop subloop1)))
   )
   objloop
)

(defun ex:offsetout ( obj offdis / subloop1 subloop2 subloop1type subloop2type subloop1length subloop2length objloop)
   (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))
   (setq subloop2type (vlax-get-property subloop2 'entityname))
   (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 objloop subloop2)))      
      ((> subloop1length subloop2length) (progn (vla-delete subloop2) (setq looplength subloop1length) (setq objloop subloop1)))
      ((= subloop1length subloop2length) (progn (vla-delete subloop2) (setq looplength subloop1length) (setq objloop subloop1)))
   )
   objloop
)


; close all by Middleton, Cliff 
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/early-christmas/m-p/777308/highlight/true#M2966

(defun C:@Q nil
  (cond
    ((= 6 (LM:popup "Close All with Save" "You want close all with save?"  36))
      (@CloseWithSave)
      (command "_close" "n")
    )
    (t (princ "\nCanceled"))
  )
  (princ)
)

(defun @CloseWithSave ( / cnt) 
  (setq cnt (@CloseAllButActive :vlax-True))
  (if (> cnt 0)
    (princ (strcat "\n[ " (itoa cnt) " ] " (if (> cnt 1) "s" "") "are saved and closed"))
    (princ "\nThere's no dwg for closing.")
  )
  (princ)
)

(defun @CloseAllButActive (TrueOrFalse / cnt)
  (setq cnt 0)
  (vlax-for Item (vla-get-Documents (vlax-get-acad-object))
    (if (= (vla-get-Active Item) :vlax-False)
      (progn
        (vla-close Item TrueOrFalse)
        (setq cnt (1+ cnt))
      )
    )
  )
  cnt
)

;; Popup  -  Lee Mac
;; A wrapper for the WSH popup method to display a message box prompting the user.
;; ttl - [str] Text to be displayed in the pop-up title bar
;; msg - [str] Text content of the message box
;; bit - [int] Bit-coded integer indicating icon & button appearance
;; Returns: [int] Integer indicating the button pressed to exit

(defun LM:popup ( ttl msg bit / wsh rtn )
    (if (setq wsh (vlax-create-object "wscript.shell"))
        (progn
            (setq rtn (vl-catch-all-apply 'vlax-invoke-method (list wsh 'popup msg 0 ttl bit)))
            (vlax-release-object wsh)
            (if (not (vl-catch-all-error-p rtn)) rtn)
        )
    )
)


(c:CNC)

if you want use basic command in lisp

  (setvar 'cmdecho 0)
  (command "_Join" "all" "")
  (setvar 'cmdecho 1)

like this way.

(setvar 'cmdecho 0) is mute.

(setvar 'cmdecho 1) is unmute.

I'm sorry. the join all command doesn't work. a tried putting ; ; for the 3 lines. didn't work. I'm a newbie!!!

June 3, 2022

On 5/31/2022 at 9:26 PM, Steven P said:

Exceed has a good solution for you.

Going back to your original post, I think that part offset inside / outside the wrong way around might be to do with how your drew the original polyline, whether you drew it in a clockwise or anticlockwise (counter clockwise) direction - if that makes sense, but you could test that to see yourself.

I had another look at this today, and here is another option for you. Command is CNC. I separated the CNC command from the rest, passing the value of offset to the next LISP, (thinking to your next step which might be to run this as a part of a script, all the drawings at once and this will give you the ability to set the offset according to each drawing).

I haven't added anything in here to open, save or close a drawing - thinking that can be done in a script routine, but see he end of Exceed and the '@' defuns for that too

(defun PolyLineArea ( MyPolyLineEntName / MyArea)
  (setq MyPolyLine (vlax-ename->vla-object MyPolyLineEntName))
  (setq MyArea (vla-get-Area MyPolyLine) )
  MyArea
)
;;;;;;;;;;;;;;;;;;;;;;
;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/find-the-largest-number-in-a-list-of-numbers/td-p/816742
(defun maxinlist (x / next highest)
  (setq next 0)
  (setq highest (nth 0 x)) ; Assumes that the first item in the list is the highest. Then iterates through every number in the list
  (while (< next (1- (length x)))
    (setq highest (max highest (nth (1+ next) x)))
    (setq next (1+ next))
  ) ;end while
  highest
)

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-offset-many-closed-objects-toward-inside-at-once/td-p/8304010
;;  Function to determine if a polyline is CW or CCW
  ;;  Returns 1 for CCW, or -1 for CW, or nil if not a polyline or only two points
(defun @CCW? (Pline / Param Sum End P1 P2 P3)
  (cond
    ((= (type Pline) 'VLA-OBJECT))
    ((= (type Pline) 'ENAME)(setq Pline (vlax-ename->vla-object Pline)))
    (1 (setq Pline nil))
  )
  (and
    Pline
    (setq Param 0.5
          Sum 0.0
          End (vlax-curve-getendparam Pline)
          P1 (vlax-curve-getstartpoint Pline)
          PType (vlax-get Pline 'ObjectName)
    ) ;end setq
    (or
      (while (not (setq P2 (vlax-curve-getpointatparam Pline Param)))
        (setq Param (+ Param 0.5))
      ) ;end while
      1
    ) ;end or
    (while (and (> End 2)(< Param End))
      (setq Param (+ Param 0.5))
      (while (not (setq P3 (vlax-curve-getpointatparam Pline Param)))
        (setq Param (+ Param 0.5))
      ) ;end while
      (setq Sum (+ Sum (@delta (angle P1 P2)(angle P2 P3)))
            P1 P2 P2 P3
      ) ;end setq
    ) ;end while
  ) ;end and
  (cond
    ((not Sum) nil)
    ((zerop Sum) nil)
    ((> Sum 0) 1)  ;; meaning it's CCW
    ((< Sum 0) -1) ;; meaning it's CW
  )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun @delta (a1 a2)
  (cond
     ((> a1 (+ a2 pi))
       (- (+ a2 pi pi) a1)
     )
     ((> a2 (+ a1 pi))
       (- a2 (+ a1 pi pi))
     )
     (1 (- a2 a1))
  )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:CNC ( / offset)
  (linearea 2)
  (princ)
)

;;;;;;;;;;;;;;;;;;;;;
(defun LineArea ( offsetdist / MyPolyLineEntName Acount AreaList)
  (vl-load-com)            ;;Load VL
  (setq AreaList (list))   ;;Blank List
  (setq ss (ssget "_A"))   ;;select set, all visible objects, change A to X for all objects

  (command "_pedit" "m" ss "" "c" "") ;Close polylines

  (setq Acount 0)          ;; Set a counter to 0
  (while (< acount (sslength ss)) ;;Loop through selection Set, ss
    (setq MyPolyLineEntName (ssname ss Acount))  ;;nth entity in ss name
    (setq AreaList (append AreaList (list (PolyLineArea MyPolyLineEntName)) )) ;;get object area from PolyLineArea function above
    (setq Acount (+ Acount 1))  ;;increase counter
  )
  (setq largestentpos (- (vl-position (maxinlist AreaList) AreaList) 0 ))
  (setq acount 0)
  (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (setq Distance (* -1 (@CCW? ent) offsetdist))
    (if (= acount largestentpos) (setq Distance (* (@CCW? ent) offsetdist)) )
    (setq acount (+ acount 1))
    (setq obj (vlax-ename->vla-object ent))
    (vla-offset obj Distance)
    (command "._CHANGE" (entlast) "" "Properties" "Color" "1" "")
  )

)

I'm sorry. the join all command doesn't work. a tried putting ; ; for the 3 lines. didn't work. I'm a newbie!!!

June 3, 2022

On 5/31/2022 at 9:49 AM, exceed said:

; CNC - 2022.05.31 exceed
; https://www.cadtutor.net/forum/topic/75276-an-offset-marco-for-cnc-plasma-cutting-process/
;
; Works on closed polylines, circles.
; Objects with the largest area are offset outward, others are offset inward.
;
; Command List
; CNC - do offset
; @Q - Save and close all opened drawings. Dialogs do not appear individually when closing each drawing. Appears only once for confirmation.
; 
; The color is designated as number 3 (green). The layer does not change.
;
; When you add this Lisp to your starter set, it will work automatically every time you open a drawing.
; Open multiple drawings and save and close them all with the @Q command.
; If you want to manually, add ; in front of (c:CNC) to make ;(c:CNC), 
; it will work when manually entering CNC
;
; Note
; If you reopen a drawing that has already been executed and saved, it will be created again. 
; In this part, it seems to be necessary to add a statement that does not execute if there is a green object in the drawing.
; Your green looks different than mine, so I didn't add this code.


(vl-load-com)
(defun c:CNC ( / offsetvalue ss ssl index arealist obj objarea objlist outerloopobj outeroffset otherloop otherlooplen index2 otherloopobj inneroffset )

  ;(setq offsetvalue 10)
  (setq offsetvalue (getreal "\n Input offset value : "))
  (if (= offsetvalue nil) (progn (princ "\n you cancel CNC offset command") (exit)) )
 
  (setvar 'cmdecho 0)
  (command "_Join" "all" "")
  (setvar 'cmdecho 1)

  (setq ss (ssget "X" '((0 . "LWPOLYLINE,CIRCLE"))))
  (setq ssl (sslength ss))
  (setq index 0)
  (setq arealist '())
  (repeat ssl
    (setq obj (vlax-ename->vla-object (ssname ss index)))
    (setq objarea (vla-get-area obj))
    (setq objlist (list obj objarea))
    (setq arealist (cons objlist arealist))
    (setq index (+ index 1))
  )
  (setq arealist (vl-sort arealist (function (lambda (x1 x2) (> (cadr x1) (cadr x2)) ) )))
  
  (setq outerloopobj (car (car arealist)))
  (setq outeroffset (ex:offsetout outerloopobj offsetvalue))
  (vlax-put-property outeroffset 'color 3)

  (setq otherloop (cdr arealist))
  (setq otherlooplen (length otherloop))
  (setq index2 0)

  (repeat otherlooplen
    (setq otherloopobj (car (nth index2 otherloop)))
    (setq inneroffset (ex:offsetin otherloopobj offsetvalue))
    (vlax-put-property inneroffset 'color 3)
    (setq index2 (+ index2 1))
  )
  

  (princ)
)
 


(defun ex:offsetin ( obj offdis / subloop1 subloop2 subloop1type subloop2type subloop1length subloop2length objloop)
   (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))
   (setq subloop2type (vlax-get-property subloop2 'entityname))
   (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 objloop subloop2)))      
      ((< subloop1length subloop2length) (progn (vla-delete subloop2) (setq looplength subloop1length) (setq objloop subloop1)))
      ((= subloop1length subloop2length) (progn (vla-delete subloop2) (setq looplength subloop1length) (setq objloop subloop1)))
   )
   objloop
)

(defun ex:offsetout ( obj offdis / subloop1 subloop2 subloop1type subloop2type subloop1length subloop2length objloop)
   (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))
   (setq subloop2type (vlax-get-property subloop2 'entityname))
   (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 objloop subloop2)))      
      ((> subloop1length subloop2length) (progn (vla-delete subloop2) (setq looplength subloop1length) (setq objloop subloop1)))
      ((= subloop1length subloop2length) (progn (vla-delete subloop2) (setq looplength subloop1length) (setq objloop subloop1)))
   )
   objloop
)


; close all by Middleton, Cliff 
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/early-christmas/m-p/777308/highlight/true#M2966

(defun C:@Q nil
  (cond
    ((= 6 (LM:popup "Close All with Save" "You want close all with save?"  36))
      (@CloseWithSave)
      (command "_close" "n")
    )
    (t (princ "\nCanceled"))
  )
  (princ)
)

(defun @CloseWithSave ( / cnt) 
  (setq cnt (@CloseAllButActive :vlax-True))
  (if (> cnt 0)
    (princ (strcat "\n[ " (itoa cnt) " ] " (if (> cnt 1) "s" "") "are saved and closed"))
    (princ "\nThere's no dwg for closing.")
  )
  (princ)
)

(defun @CloseAllButActive (TrueOrFalse / cnt)
  (setq cnt 0)
  (vlax-for Item (vla-get-Documents (vlax-get-acad-object))
    (if (= (vla-get-Active Item) :vlax-False)
      (progn
        (vla-close Item TrueOrFalse)
        (setq cnt (1+ cnt))
      )
    )
  )
  cnt
)

;; Popup  -  Lee Mac
;; A wrapper for the WSH popup method to display a message box prompting the user.
;; ttl - [str] Text to be displayed in the pop-up title bar
;; msg - [str] Text content of the message box
;; bit - [int] Bit-coded integer indicating icon & button appearance
;; Returns: [int] Integer indicating the button pressed to exit

(defun LM:popup ( ttl msg bit / wsh rtn )
    (if (setq wsh (vlax-create-object "wscript.shell"))
        (progn
            (setq rtn (vl-catch-all-apply 'vlax-invoke-method (list wsh 'popup msg 0 ttl bit)))
            (vlax-release-object wsh)
            (if (not (vl-catch-all-error-p rtn)) rtn)
        )
    )
)


(c:CNC)

if you want use basic command in lisp

  (setvar 'cmdecho 0)
  (command "_Join" "all" "")
  (setvar 'cmdecho 1)

like this way.

(setvar 'cmdecho 0) is mute.

(setvar 'cmdecho 1) is unmute.

How can we add an option to delete the original joined objects? It would be wonderful.

P

June 3, 2022

2 hours ago, abghrnjd said:

I'm sorry. the join all command doesn't work. a tried putting ; ; for the 3 lines. didn't work. I'm a newbie!!!

Try putting this

(command "_pedit" "m" ss "" "c" "")

after exceeds (setq ss (ssget....) line

June 3, 2022

2 hours ago, abghrnjd said:

How can we add an option to delete the original joined objects? It would be wonderful.

P

To delete the original objects and leave the offset objects?

June 3, 2022

36 minutes ago, Steven P said:

To delete the original objects and leave the offset objects?

Thank you.

- unfortunately (command "_pedit" "m" ss "" "c" "") didn't work either.

- Yes. sometimes I want to delete the original objects. (most of the time!)

- Can I save the file with different names. using a "save as" function?

June 3, 2022

6 hours ago, abghrnjd said:

Thank you.

- unfortunately (command "_pedit" "m" ss "" "c" "") didn't work either.

- Yes. sometimes I want to delete the original objects. (most of the time!)

- Can I save the file with different names. using a "save as" function?

Try my version see what happens there with closing the polylines. I will assume that they are 2d polyline, but what is happening for them not to work?

to delete the original objects I would put an:

(entdel ent)

at the end of my while loop in the line area defun

There are 'save as' lisp routines out there you can copy and paste, but the basic code is:

(COMMAND "_saveas" "" "~")

You might then update my code, change c:cnc to include a getkword Y or N to ask delete original items and the same to ask save as, and to do that code in the linearea lisp.

So, so far you might have:

(defun PolyLineArea ( MyPolyLineEntName / MyArea)
  (setq MyPolyLine (vlax-ename->vla-object MyPolyLineEntName))
  (setq MyArea (vla-get-Area MyPolyLine) )
  MyArea
)
;;;;;;;;;;;;;;;;;;;;;;
;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/find-the-largest-number-in-a-list-of-numbers/td-p/816742
(defun maxinlist (x / next highest)
  (setq next 0)
  (setq highest (nth 0 x)) ; Assumes that the first item in the list is the highest. Then iterates through every number in the list
  (while (< next (1- (length x)))
    (setq highest (max highest (nth (1+ next) x)))
    (setq next (1+ next))
  ) ;end while
  highest
)

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-offset-many-closed-objects-toward-inside-at-once/td-p/8304010
;;  Function to determine if a polyline is CW or CCW
  ;;  Returns 1 for CCW, or -1 for CW, or nil if not a polyline or only two points
  (defun @CCW? (Pline / Param Sum End P1 P2 P3)
    (cond
      ((= (type Pline) 'VLA-OBJECT))
      ((= (type Pline) 'ENAME)(setq Pline (vlax-ename->vla-object Pline)))
      (1 (setq Pline nil))
    )
    (and
      Pline
      (setq Param 0.5
            Sum 0.0
            End (vlax-curve-getendparam Pline)
            P1 (vlax-curve-getstartpoint Pline)
            PType (vlax-get Pline 'ObjectName)
      )
      (or
        (while (not (setq P2 (vlax-curve-getpointatparam Pline Param)))
          (setq Param (+ Param 0.5))
        )
        1
      )
      (while (and (> End 2)(< Param End))
        (setq Param (+ Param 0.5))
        (while (not (setq P3 (vlax-curve-getpointatparam Pline Param)))
          (setq Param (+ Param 0.5))
        )
        (setq Sum (+ Sum (@delta (angle P1 P2)(angle P2 P3)))
              P1 P2 P2 P3
        )
      )
    )
    (cond
      ((not Sum) nil)
      ((zerop Sum) nil)
      ((> Sum 0) 1)  ;; meaning it's CCW
      ((< Sum 0) -1) ;; meaning it's CW
    )
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun @delta (a1 a2)
  (cond
     ((> a1 (+ a2 pi))
       (- (+ a2 pi pi) a1)
     )
     ((> a2 (+ a1 pi))
       (- a2 (+ a1 pi pi))
     )
     (1 (- a2 a1))
  )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;
(defun c:CNC ( / offsetdist deleteoriginal Saveasmodified)
  (setq offsetdist (getreal "Offset?"))
  (initget "Y N y n")
  (setq deleteoriginal (strcase (getkword "Delete Original Lines? [Y/N]")))
  (initget "Y N y n")
  (setq Saveasmodified (strcase (getkword "Save as new drawing? [Y/N]")))
  (linearea offsetdist deleteoriginal Saveasmodified)
  (princ)
)

;;;;;;;;;;;;;;;;;;;;;
(defun LineArea ( offsetdist deleteoriginal Saveasmodified / MyPolyLineEntName Acount AreaList)
  (vl-load-com)            ;;Load VL
  (setq AreaList (list))   ;;Blank List

  (setq ss (ssget "_A"))   ;;select set, all visible objects, change A to X for all objects
  (command "_pedit" "m" ss "" "c" "") ;Close polylines

  (setq Acount 0)          ;; Set a counter to 0
  (while (< acount (sslength ss)) ;;Loop through selection Set, ss
    (setq MyPolyLineEntName (ssname ss Acount))  ;;nth entity in ss name
    (setq AreaList (append AreaList (list (PolyLineArea MyPolyLineEntName)) )) ;;get object area from PolyLineArea function above
    (setq Acount (+ Acount 1))  ;;increase counter
  )
  (setq largestentpos (- (vl-position (maxinlist AreaList) AreaList) 0 ))
  (setq acount 0)
  (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (setq Distance (* -1 (@CCW? ent) offsetdist))
    (if (= acount largestentpos) (setq Distance (* (@CCW? ent) offsetdist)) )
    (setq acount (+ acount 1))
    (setq obj (vlax-ename->vla-object ent))
    (vla-offset obj Distance)
    (command "._CHANGE" (entlast) "" "Properties" "Color" "1" "")
    (if (= deleteoriginal "Y") (entdel ent))
  ) ;end for each

  (if (= Saveasmodified "Y")(COMMAND "_saveas" "" "~"))

)

With the above if you modify the saveas part you could run this as a batch or script

- open drawing

- run linearea adding in the offset, delete original and a [modified lisp input] filename / filepath

- close drawing

- open next drawing,,,,,

Edited June 3, 2022 by Steven P

Sign In

An offset Marco for CNC Plasma cutting process!

Recommended Posts

Steven P

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

exceed

Steven P

exceed

Posted Images

ronjonp

Steven P

abghrnjd

abghrnjd

abghrnjd

Steven P

Steven P

abghrnjd

Steven P

Join the conversation

exceed

Steven P

exceed

Tutorials

Forums

Activity