Offset delete program - How can I get this to work in different UCS

March 14, 2024

;|

ABOUT
- Offsets by specified distance and deletes the original but in the case of
  Polylines it recreates them. This is to preserve the associative hatches if
  there any.
- Distance remembered through different ACAD sessions. Variable saved to the
  registry.
- Non Polyline code done by user ronjonp here: http://www.cadtutor.net/forum/showthread.php?24646-Offset-and-delete-source&p=699122&viewfull=1#post699122
- Polyline recreation code from here: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/replace-polyine-geometry-with-another-polylines-geometry-lisp/m-p/7134030#M354113
- My thread for help here: https://www.cadtutor.net/forum/topic/75500-offset-delete-fixed-with-associated-hatches-minor-problem-hatch-wont-update/

MY EDITS, BY 3dwannab
2018.03.24
- I've added a loop to pick more objects for offset after the first one is
  completed. and error checking to only select offset-able objects.
- It also doesn't fail if nothings selected.

2022.06.25
- Added support to recreate Polyline as the offset position. This will preserve
  any associative hatches if there any.
- Added proper undo handling.

  2022.07.13
- Fixed the while loop bug and updating of hatches after each offset.

USAGE
'ODEL' or 'OFFSET_DELETE'.

TO DO
Add an option at the start to delete or not

|;

(defun c:ODEL nil (c:OFFSET_DELETE))

(defun c:OFFSET_DELETE (/ acDoc *error* cordins ent entPlTemp i o offDisStr ptOffside ssOffset ssOrg typ)

  (defun *error* (errmsg)
    (and acDoc (vla-EndUndoMark acDoc))
    (and errmsg
         (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
         (princ (strcat "\n<< Error: " errmsg " >>\n"))
    )
  )

  (vla-StartUndoMark (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object))))

  (setq offDisStr (atof (cond ((getenv "MyOffsetProgram")) ("1")))) ;; Get saved offset from registry or default to 1

  (while

    (if

      (and
        (setq offDisStr (cond ((getdist (strcat "\nOffset distance <" (vl-princ-to-string offDisStr) ">: "))) (offDisStr))) ;; Prompt for distance, if nil use default
        (setq ssOrg (LM:ssget "\nSelect object to offset :" '("_:L" ((0 . "*")))))
        (setq ptOffside (cond ((getpoint "\nSpecify point on side to offset : ")) ((cadr ssOrg)))) ;; Pick a side to offset or use point in entsel
      )

      ;; If selection is valid
      (progn

        (setenv "MyOffsetProgram" (vl-princ-to-string offDisStr)) ;; Write our default offset to registry

        ;; Loop through each entity in the selection set
        (repeat (setq i (sslength ssOrg))
          (if
            (and
              (setq o (vlax-ename->vla-object (ssname ssOrg (setq i (1- i)))))
              (vlax-method-applicable-p o 'offset)
            )

            ;; Begin offsetting objects
            (progn
              (setq e (ssname ssOrg i))
              (setq typ (cdr (assoc 0 (entget e)))) ;; Get the type of object, i.e. POLYLINE, LINE etc

              (setq ssOffset (ssadd))
              (setq ssOffset (ssadd e ssOffset))

              ;; Offset all other items apart from polylines
              (cond
                ((not (wcmatch typ "*POLYLINE"))

                 (lmac-offset ssOffset ptOffside offDisStr)

                 (entdel e) ;; Delete original (entdel won't **** the bed if the object is locked)
                ) ;; End cond for all but POLYLINES

                ;; Offset polylines only but recreate them based on the offset polyline verts
                ((wcmatch typ "*POLYLINE")

                 (lmac-offset ssOffset ptOffside offDisStr)

                 (setq cordins (@Plist (entlast))) ;; Get the coordinates of the offset polyline
                 (setq entPlTemp (entlast)) ;; Set the variable for the newly created temporary entity
                 ;; Put the properties of the new offset polyline to the original one to preserve
                 ;; any associative hatches there may or not be.
                 (if entPlTemp
                   (progn
                     (@put_data (vlax-ename->vla-object e) (@Plist entPlTemp))
                     (command "._regen") ;; This little blitter was the fix to update the hatch. I had also ill formatted the cond part and it was breaking the loop
                     (entdel entPlTemp) ;; Delete the temporary polyline
                   )
                 ) ;; End if entPlTemp
                ) ;; End cond for POLYLINES
              )

              (ssdel e ssOffset) ;; Delete the entity from the selection set at the end
            ) ;; end progn for offsetting
          )
        ) ;; end repeat for selection set
      ) ;; end progn for T if
    ) ;; End if
  ) ;; End while

  ;; This doesn't really do anything outside here as the hatch updates anyway.
  ;; Having this in the while loop breaks out if the loop so no point it in there either!!
  ; (vla-Regen acDoc acAllViewports)

  (vla-EndUndoMark acDoc)
  (*error* nil)
  (princ)
)

;; ssget - Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments
(defun LM:ssget (msg arg / sel)
  (princ msg)
  (setvar 'nomutt 1)
  (setq sel (vl-catch-all-apply 'ssget arg))
  (setvar 'nomutt 0)
  (if (not (vl-catch-all-error-p sel)) sel)
)

;; Return LWpolyline data in the format.
;; Credit to john.uhden, defun found here: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/replace-polyine-geometry-with-another-polylines-geometry-lisp/m-p/10596684#M419793
;; '((b1 x1 y1)(b2 x2 y2) ... (bn xn yn))
(defun @Plist (E / plist blist)
  (setq ent (entget e))
  (setq plist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) ent)))
  (setq blist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) ent)))
  (setq plist (mapcar 'cons blist plist))
)

;; Apply the collected data from the @Plist function to another LWpolyline.
;; Credit to john.uhden, defun found here: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/replace-polyine-geometry-with-another-polylines-geometry-lisp/m-p/10596684#M419793
;; where obj is a polyline vla-object
(defun @put_data (obj plist / param)
  (vlax-put obj 'Coordinates (apply 'append (mapcar 'cdr plist)))
  (setq param 0) ;; parameter index
  (repeat (length plist)
    (vla-setbulge obj param (car (nth param plist)))
    (setq param (1+ param))
  )
)

;; Will Offset a SelSet to the side chosen at distance specified ;;
;; Args:                                                         ;;
;; ss   ~   SelectionSet                                         ;;
;; pt   ~   Point specifying the side to offset                  ;;
;; dis  ~   Distance to Offset                                   ;;
;; Returns:                                                      ;;
;; List of Offset Objects                                        ;;
(defun lmac-offset (ss pt dis / ent obj l)
  (vl-load-com)
  ;; © Lee Mac  ~  25.03.10

  ((lambda (i)

     (cond
       ((not
          (and (eq 'PICKSET (type ss))
               (numberp dis)
               (vl-consp pt)
          )
        )
       )

       ((while (setq ent (ssname ss (setq i (1+ i))))

          (if
            (vlax-method-applicable-p
              (setq obj (vlax-ename->vla-object ent))
              'Offset
            )

            (mapcar
              (function vla-delete)
              (car
                (setq l (append
                          (vl-sort
                            (mapcar
                              (function
                                (lambda (x)
                                  (vlax-invoke obj 'Offset x)
                                )
                              )
                              (list dis (- dis))
                            )

                            (function
                              (lambda (a b)
                                (> (distance pt (vlax-curve-getClosestPointto (car a) pt))
                                   (distance pt (vlax-curve-getClosestPointto (car b) pt))
                                )
                              )
                            )
                          )

                          (cdr l)
                        )
                )
              )
            )
          )
        )
       )
     )
   )
    -1
  )

  (apply (function append) (cdr l))
)
(princ
  (strcat
    "\nOffset_Delete.lsp edited on "
    (menucmd "m=$(edtime,0,DD-MO-yyyy)")
    " by 3dwannab (stephensherry147@yahoo.co.uk) loaded"
    "\nType \"ODEL\" or \"OFFSET_DELETE\" to run Program"
  )
)
(princ)
; (c:ODEL)

See the attached drawing where it offsets to the left side no matter what. How can I fix this?

Offsets to the left no matter what side.dwg

March 14, 2024

something is up with the lmac-offse funciton or im not understanding cuz its mapcar wrap in a function thats wrapped in a sort thats wrapped in a mapcar thats wrapped in a lambda thats wrapped in a funciton to say delete this line but its defaulting to witch ever is drawn first. it looks edited so maybe go and download it again?

Website · March 15, 2024

The program ODEL has a couple of glitches but I did not find inside vs outsideto to be one of them.

ODEL does seem to have a harder time dealing with edges that "disappear" for inside offset if the distance would nulify a line segment. Red lines are the results of offset and green ODEL

ODEL does not handle polylines that are technically "open" but can be considered closed from the fact that their first and last vertices are coincidet. The red polyline is the result of OFFSET and the GREEN is create by ODEL.

March 15, 2024

@lrm. I'm starting my holidays now but never tested my issue with the original ODEL program. Have you tested it with my .dwg file in the starting post?

March 16, 2024

"- Distance remembered through different ACAD sessions. Variable saved to the registry."

Use Ldata can be used in every dwg you want and same key name each time.

Edited March 16, 2024 by BIGAL

October 20, 2024

On 3/16/2024 at 4:00 AM, BIGAL said:

"- Distance remembered through different ACAD sessions. Variable saved to the registry."

When I type that in, it says it's a read only variable.

I got this fixed. It was a problem my end and no Lee Macs function. I just needed to use the trans function on the picked point.

;|

ABOUT
- Offsets by specified distance and deletes the original but in the case of
  Polylines it recreates them. This is to preserve the associative hatches if
  there any.
- Distance remembered through different ACAD sessions. Variable saved to the
  registry.
- Non Polyline code done by user ronjonp here: http://www.cadtutor.net/forum/showthread.php?24646-Offset-and-delete-source&p=699122&viewfull=1#post699122
- Polyline recreation code from here: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/replace-polyine-geometry-with-another-polylines-geometry-lisp/m-p/7134030#M354113
- My thread for help here: https://www.cadtutor.net/forum/topic/75500-offset-delete-fixed-with-associated-hatches-minor-problem-hatch-wont-update/

MY EDITS, BY 3dwannab
2018.03.24
- I've added a loop to pick more objects for offset after the first one is
  completed. and error checking to only select offset-able objects.
- It also doesn't fail if nothings selected.

2022.06.25
- Added support to recreate Polyline as the offset position. This will preserve
  any associative hatches if there any.
- Added proper undo handling.

  2022.07.13
- Fixed the while loop bug and updating of hatches after each offset.

  2024.10.20
- Fixed the side it gets offset when in a different UCS. See: (setq ptOffside (trans ptOffside 1 0))

USAGE
'ODEL' or 'OFFSET_DELETE'.

TO DO

|;

(defun c:ODEL nil (c:OFFSET_DELETE))

(defun c:OFFSET_DELETE (/ acDoc *error* cordins ent entPlTemp i o offDisStr ptOffside ssOffset ssOrg typ) 

  (defun *error* (errmsg) 
    (and acDoc (vla-EndUndoMark acDoc))
    (and errmsg 
         (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
         (princ (strcat "\n<< Error: " errmsg " >>\n"))
    )
  )

  (vla-StartUndoMark (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object))))

  (setq offDisStr (atof (cond ((getenv "MyOffsetProgram")) ("1")))) ;; Get saved offset from registry or default to 1

  (while 

    (if 

      (and 
        (setq offDisStr (cond ((getdist (strcat "\nOffset distance <" (vl-princ-to-string offDisStr) ">: "))) (offDisStr))) ;; Prompt for distance, if nil use default
        (setq ssOrg (LM:ssget "\nSelect object to offset :" '("_:L" ((0 . "*")))))
        (setq ptOffside (cond ((getpoint "\nSpecify point on side to offset : ")) ((cadr ssOrg)))) ;; Pick a side to offset or use point in entsel
      )

      ;; If selection is valid
      (progn 

        (setq ptOffside (trans ptOffside 1 0)) ;; Transform from UCS (1) to WCS (0)

        (setenv "MyOffsetProgram" (vl-princ-to-string offDisStr)) ;; Write our default offset to registry

        ;; Loop through each entity in the selection set
        (repeat (setq i (sslength ssOrg)) 
          (if 
            (and 
              (setq o (vlax-ename->vla-object (ssname ssOrg (setq i (1- i)))))
              (vlax-method-applicable-p o 'offset)
            )

            ;; Begin offsetting objects
            (progn 
              (setq e (ssname ssOrg i))
              (setq typ (cdr (assoc 0 (entget e)))) ;; Get the type of object, i.e. POLYLINE, LINE etc

              (setq ssOffset (ssadd))
              (setq ssOffset (ssadd e ssOffset))

              ;; Offset all other items apart from polylines
              (cond 
                ((not (wcmatch typ "*POLYLINE"))

                 (lmac-offset ssOffset ptOffside offDisStr)

                 (entdel e) ;; Delete original (entdel won't **** the bed if the object is locked)
                ) ;; End cond for all but POLYLINES

                ;; Offset polylines only but recreate them based on the offset polyline verts
                ((wcmatch typ "*POLYLINE")

                 (lmac-offset ssOffset ptOffside offDisStr)

                 (setq cordins (@Plist (entlast))) ;; Get the coordinates of the offset polyline
                 (setq entPlTemp (entlast)) ;; Set the variable for the newly created temporary entity
                 ;; Put the properties of the new offset polyline to the original one to preserve
                 ;; any associative hatches there may or not be.
                 (if entPlTemp 
                   (progn 
                     (@put_data (vlax-ename->vla-object e) (@Plist entPlTemp))
                     (command "._regen") ;; This little blitter was the fix to update the hatch. I had also ill formatted the cond part and it was breaking the loop
                     (entdel entPlTemp) ;; Delete the temporary polyline
                   )
                 ) ;; End if entPlTemp
                ) ;; End cond for POLYLINES
              )

              (ssdel e ssOffset) ;; Delete the entity from the selection set at the end
            ) ;; end progn for offsetting
          )
        ) ;; end repeat for selection set
      ) ;; end progn for T if
    ) ;; End if
  ) ;; End while

  ;; This doesn't really do anything outside here as the hatch updates anyway.
  ;; Having this in the while loop breaks out if the loop so no point it in there either!!
  ; (vla-Regen acDoc acAllViewports)

  (vla-EndUndoMark acDoc)
  (*error* nil)
  (princ)
)

;; ssget - Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments
(defun LM:ssget (msg arg / sel) 
  (princ msg)
  (setvar 'nomutt 1)
  (setq sel (vl-catch-all-apply 'ssget arg))
  (setvar 'nomutt 0)
  (if (not (vl-catch-all-error-p sel)) sel)
)

;; Return LWpolyline data in the format.
;; Credit to john.uhden, defun found here: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/replace-polyine-geometry-with-another-polylines-geometry-lisp/m-p/10596684#M419793
;; '((b1 x1 y1)(b2 x2 y2) ... (bn xn yn))
(defun @Plist (E / plist blist) 
  (setq ent (entget e))
  (setq plist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) ent)))
  (setq blist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) ent)))
  (setq plist (mapcar 'cons blist plist))
)

;; Apply the collected data from the @Plist function to another LWpolyline.
;; Credit to john.uhden, defun found here: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/replace-polyine-geometry-with-another-polylines-geometry-lisp/m-p/10596684#M419793
;; where obj is a polyline vla-object
(defun @put_data (obj plist / param) 
  (vlax-put obj 'Coordinates (apply 'append (mapcar 'cdr plist)))
  (setq param 0) ;; parameter index
  (repeat (length plist) 
    (vla-setbulge obj param (car (nth param plist)))
    (setq param (1+ param))
  )
)

;; Will Offset a SelSet to the side chosen at distance specified ;;
;; Args:                                                         ;;
;; ss   ~   SelectionSet                                         ;;
;; pt   ~   Point specifying the side to offset                  ;;
;; dis  ~   Distance to Offset                                   ;;
;; Returns:                                                      ;;
;; List of Offset Objects                                        ;;
(defun lmac-offset (ss pt dis / ent obj l) 
  (vl-load-com)
  ;; © Lee Mac  ~  25.03.10

  ((lambda (i) 

     (cond 
       ((not 
          (and (eq 'PICKSET (type ss)) 
               (numberp dis)
               (vl-consp pt)
          )
        )
       )

       ((while (setq ent (ssname ss (setq i (1+ i)))) 

          (if 
            (vlax-method-applicable-p 
              (setq obj (vlax-ename->vla-object ent))
              'Offset
            )

            (mapcar 
              (function vla-delete)
              (car 
                (setq l (append 
                          (vl-sort 
                            (mapcar 
                              (function 
                                (lambda (x) 
                                  (vlax-invoke obj 'Offset x)
                                )
                              )
                              (list dis (- dis))
                            )

                            (function 
                              (lambda (a b) 
                                (> (distance pt (vlax-curve-getClosestPointto (car a) pt)) 
                                   (distance pt (vlax-curve-getClosestPointto (car b) pt))
                                )
                              )
                            )
                          )

                          (cdr l)
                        )
                )
              )
            )
          )
        )
       )
     )
   ) 
    -1
  )

  (apply (function append) (cdr l))
)
(princ 
  (strcat 
    "\nOffset_Delete.lsp edited on "
    (menucmd "m=$(edtime,0,DD-MO-yyyy)")
    " by 3dwannab (stephensherry147@yahoo.co.uk) loaded"
    "\nType \"ODEL\" or \"OFFSET_DELETE\" to run Program"
  )
)
(princ)

;;(c:ODEL) ;; Unblock for testing

Sign In

Offset delete program - How can I get this to work in different UCS

Recommended Posts

3dwannab

mhupp

lrm

3dwannab

BIGAL

3dwannab

Join the conversation

Tutorials

Forums

Activity