Jump to content

An offset Marco for CNC Plasma cutting process!

abghrnjd

By abghrnjd
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Steven P Grand Master

Steven P

Posted
Posted
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?

Link to comment
Share on other sites
  • Replies 29
  • Created
  • Last Reply

Top Posters In This Topic

  • abghrnjd

    11

  • Steven P

    8

  • exceed

    5

  • mhupp

    3

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

exceed
exceed

To tell the machine what you want to do, have to think more step by step.    You may have questions such as:  Q1. Does 1 dwg contain only 1 part?  Q2. Doesn't one dwg contain objec

Steven P
Steven P

Just to get you going a bit, this should return the entity name of the largest area polyline in your drawing. Command LineArea   (defun PolyLineArea ( MyPolyLineEntName / MyArea) (setq MyPol

exceed
exceed

; 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 offse

Posted Images

ronjonp Grand Master

ronjonp

Posted
Posted
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 :)

  • Like 1
Link to comment
Share on other sites
Steven P Grand Master

Steven P

Posted
Posted

'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?

Link to comment
Share on other sites
abghrnjd Rookie

abghrnjd

Posted
  • Author
Posted
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!!! :(

Link to comment
Share on other sites
abghrnjd Rookie

abghrnjd

Posted
  • Author
Posted
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!!! 

Link to comment
Share on other sites
abghrnjd Rookie

abghrnjd

Posted
  • Author
Posted
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

Link to comment
Share on other sites
Steven P Grand Master

Steven P

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

  • Like 1
Link to comment
Share on other sites
Steven P Grand Master

Steven P

Posted
Posted
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?

  • Like 1
Link to comment
Share on other sites
abghrnjd Rookie

abghrnjd

Posted
  • Author
Posted
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?

Link to comment
Share on other sites
Steven P Grand Master

Steven P

Posted
Posted (edited)
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 by Steven P
  • Like 1
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.

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