Erase objects outside of boundary ( polyline )

[marko_ribar]

Have you compared your version of EXTRIM.lsp with mine? I think you have problems with correct execution of (etrim ent pt) function... Please, revise this post, although on my machines A2009 x86 and A2012 x64 it works correctly without modification to EIO.lsp that I've modified - post #47 with changed factor for offset from 0.001 to 0.01...

 

(defun c:EIO (/ *error* _p2ss _ext _Pnt cmd ucs o o- ent u ssIn ssOut)
 ;; Erase Inside/Outside of selected LWPolyline
 ;; If Express Tools' EXTrim is found/loaded, crossing object(s) will be trimmed
 ;; Alan J. Thompson, 04.02.10

 (vl-load-com)

 (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
 (or *EIO:Opt* (setq *EIO:Opt* "Inside"))

 (defun *error* (#Message)
   (and ucs (vl-cmdf "_.ucs" "_p"))
   (and cmd (setvar 'cmdecho cmd))
   (and *AcadDoc* u (vla-endundomark *AcadDoc*))
   (and #Message
        (not (wcmatch (strcase #Message) "*BREAK*,*CANCEL*,*QUIT*"))
        (princ (strcat "\nError: " #Message))
   ) ;_ and
 ) ;_ defun

 (setq _p2ss (lambda (ename meth)
               (ssget meth
                      ((lambda (e / l)
                         (foreach x e (and (eq 10 (car x)) (setq l (cons (cdr x) l))))
                         l
                       ) ;_ lambda
                        (entget ename)
                      )
               ) ;_ ssget
             ) ;_ lambda
       _ext  (lambda (e p)
               (and (load "extrim.lsp" nil)
                    etrim
               ) ;_and
               (acet-error-init (list
                  (list   "cmdecho" 0
                        "highlight" 0
                        "regenmode" 1
                           "osmode" 0
                          "ucsicon" 0
                       "offsetdist" 0
                           "attreq" 0
                         "plinewid" 0
                        "plinetype" 1
                         "gridmode" 0
                          "celtype" "CONTINUOUS"
                        "ucsfollow" 0
                         "limcheck" 0
                  )
                  T     ;flag. True means use undo for error clean up.
                  '(if redraw_it (redraw na 4))
                 );list
               );acet-error-init
               (etrim e (trans p 1 0))
               (acet-error-restore)
             ) ;_ lambda

       _Pnt  (lambda (e s / e o l p)
               (setq e (vlax-ename->vla-object e))
               (setq p (vlax-curve-getendpoint
                         (caar (vl-sort
                                 (cons
                                   (cons e (vla-get-area e))
                                   (setq l (mapcar
                                             (function
                                               (lambda (# / o)
                                                 (if (setq
                                                       o
                                                        (car
                                                          (vlax-safearray->list
                                                            (vlax-variant-value (vla-offset e (* # 0.01)))
                                                          ) ;_ vlax-safearray->list
                                                        ) ;_ car
                                                     ) ;_ setq
                                                   (cons o (vla-get-area o))
                                                 ) ;_ if
                                               ) ;_ lambda
                                             ) ;_ function
                                             '(-1. 1.)
                                           ) ;_ mapcar
                                   ) ;_ setq
                                 ) ;_ cons
                                 (function (lambda (a b) (s (cdr a) (cdr b))))
                               ) ;_ vl-sort
                         ) ;_ caar
                       ) ;_ vlax-curve-getendpoint
               ) ;_ setq
               (mapcar
                 (function (lambda (x) (vl-catch-all-apply (function vla-delete) (list (car x)))))
                 l
               ) ;_ mapcar
               p
             ) ;_ lambda
 ) ;_ setq



 (and (setq o (car (entsel "\nSelect LWPolyline: ")))
      (or (eq "LWPOLYLINE" (cdr (assoc 0 (setq ent (entget o)))))
          (alert "Invalid object!")
      ) ;_ or
      (not (initget 0 "Inside Outside"))
      (setq *EIO:Opt*
             (cond
               ((getkword (strcat "\nSpecify erase option [inside/Outside] <" *EIO:Opt* ">: ")))
               (*EIO:Opt*)
             ) ;_ cond
      ) ;_ setq
      (setq u (not (vla-startundomark *AcadDoc*)))

      (setq cmd (getvar 'cmdecho))
      (setvar 'cmdecho 0)
      (or (not (zerop (getvar 'worlducs)))
          (setq ucs (vl-cmdf "_.ucs" ""))
      ) ;_ or

      (cond
        ((eq *EIO:Opt* "Inside")
         (_ext o (_pnt o <))
         (command "_.offset" "_T" o "_non" (_pnt o <) "")
         (setq o- (entlast))
         (and (setq ssIn (_p2ss o- "_CP"))
              (ssadd o- ssIn)
              ((lambda (i)
                 (while (setq e (ssname ssIn (setq i (1+ i))))
                   (or (eq o e) (vl-catch-all-apply (function entdel) (list e)))
                 ) ;_ while
               ) ;_ lambda
               -1
              )
         ) ;_ and
        )

        ((eq *EIO:Opt* "Outside")
         (_ext o (_pnt o >))
         (command "_.offset" "_T" o "_non" (_pnt o <) "")
         (setq o- (entlast))
         (and (setq ssIn  (_p2ss o- "_CP")
                    ssOut (ssget "_X" (list (cons 410 (getvar 'ctab))))
              ) ;_ setq
              (if ssIn (setq ssOut (acet-ss-remove ssIn ssOut)))
              ((lambda (i)
                 (while (setq e (ssname ssOut (setq i (1+ i))))
                   (or (eq e o) (vl-catch-all-apply (function entdel) (list e)))
                 ) ;_ while
               ) ;_ lambda
               -1
              )
              (entdel o-)
         ) ;_ and
        )
      ) ;_ cond
 ) ;_ and
 (*error* nil)
 (princ)
) ;_ defun

 

M.R.

Edited April 13, 2013 by marko_ribar
code EIO.lsp added

[JamalNUMAN]

Have you compared your version of EXTRIM.lsp with mine? I think you have problems with correct execution of (etrim ent pt) function... Please, revise this post, although on my machines A2009 x86 and A2012 x64 it works correctly without modification to EIO.lsp that I've modified - post #47 with changed factor for offset from 0.001 to 0.01...

 

(defun c:EIO (/ *error* _p2ss _ext _Pnt cmd ucs o o- ent u ssIn ssOut)
 ;; Erase Inside/Outside of selected LWPolyline
 ;; If Express Tools' EXTrim is found/loaded, crossing object(s) will be trimmed
 ;; Alan J. Thompson, 04.02.10

 (vl-load-com)

 (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
 (or *EIO:Opt* (setq *EIO:Opt* "Inside"))

 (defun *error* (#Message)
   (and ucs (vl-cmdf "_.ucs" "_p"))
   (and cmd (setvar 'cmdecho cmd))
   (and *AcadDoc* u (vla-endundomark *AcadDoc*))
   (and #Message
        (not (wcmatch (strcase #Message) "*BREAK*,*CANCEL*,*QUIT*"))
        (princ (strcat "\nError: " #Message))
   ) ;_ and
 ) ;_ defun

 (setq _p2ss (lambda (ename meth)
               (ssget meth
                      ((lambda (e / l)
                         (foreach x e (and (eq 10 (car x)) (setq l (cons (cdr x) l))))
                         l
                       ) ;_ lambda
                        (entget ename)
                      )
               ) ;_ ssget
             ) ;_ lambda
       _ext  (lambda (e p)
               (and (load "extrim.lsp" nil)
                    etrim
               ) ;_and
               (acet-error-init (list
                  (list   "cmdecho" 0
                        "highlight" 0
                        "regenmode" 1
                           "osmode" 0
                          "ucsicon" 0
                       "offsetdist" 0
                           "attreq" 0
                         "plinewid" 0
                        "plinetype" 1
                         "gridmode" 0
                          "celtype" "CONTINUOUS"
                        "ucsfollow" 0
                         "limcheck" 0
                  )
                  T     ;flag. True means use undo for error clean up.
                  '(if redraw_it (redraw na 4))
                 );list
               );acet-error-init
               (etrim e (trans p 1 0))
               (acet-error-restore)
             ) ;_ lambda

       _Pnt  (lambda (e s / e o l p)
               (setq e (vlax-ename->vla-object e))
               (setq p (vlax-curve-getendpoint
                         (caar (vl-sort
                                 (cons
                                   (cons e (vla-get-area e))
                                   (setq l (mapcar
                                             (function
                                               (lambda (# / o)
                                                 (if (setq
                                                       o
                                                        (car
                                                          (vlax-safearray->list
                                                            (vlax-variant-value (vla-offset e (* # 0.01)))
                                                          ) ;_ vlax-safearray->list
                                                        ) ;_ car
                                                     ) ;_ setq
                                                   (cons o (vla-get-area o))
                                                 ) ;_ if
                                               ) ;_ lambda
                                             ) ;_ function
                                             '(-1. 1.)
                                           ) ;_ mapcar
                                   ) ;_ setq
                                 ) ;_ cons
                                 (function (lambda (a b) (s (cdr a) (cdr b))))
                               ) ;_ vl-sort
                         ) ;_ caar
                       ) ;_ vlax-curve-getendpoint
               ) ;_ setq
               (mapcar
                 (function (lambda (x) (vl-catch-all-apply (function vla-delete) (list (car x)))))
                 l
               ) ;_ mapcar
               p
             ) ;_ lambda
 ) ;_ setq



 (and (setq o (car (entsel "\nSelect LWPolyline: ")))
      (or (eq "LWPOLYLINE" (cdr (assoc 0 (setq ent (entget o)))))
          (alert "Invalid object!")
      ) ;_ or
      (not (initget 0 "Inside Outside"))
      (setq *EIO:Opt*
             (cond
               ((getkword (strcat "\nSpecify erase option [inside/Outside] <" *EIO:Opt* ">: ")))
               (*EIO:Opt*)
             ) ;_ cond
      ) ;_ setq
      (setq u (not (vla-startundomark *AcadDoc*)))

      (setq cmd (getvar 'cmdecho))
      (setvar 'cmdecho 0)
      (or (not (zerop (getvar 'worlducs)))
          (setq ucs (vl-cmdf "_.ucs" ""))
      ) ;_ or

      (cond
        ((eq *EIO:Opt* "Inside")
         (_ext o (_pnt o <))
         (command "_.offset" "_T" o "_non" (_pnt o <) "")
         (setq o- (entlast))
         (and (setq ssIn (_p2ss o- "_CP"))
              (ssadd o- ssIn)
              ((lambda (i)
                 (while (setq e (ssname ssIn (setq i (1+ i))))
                   (or (eq o e) (vl-catch-all-apply (function entdel) (list e)))
                 ) ;_ while
               ) ;_ lambda
               -1
              )
         ) ;_ and
        )

        ((eq *EIO:Opt* "Outside")
         (_ext o (_pnt o >))
         (command "_.offset" "_T" o "_non" (_pnt o <) "")
         (setq o- (entlast))
         (and (setq ssIn  (_p2ss o- "_CP")
                    ssOut (ssget "_X" (list (cons 410 (getvar 'ctab))))
              ) ;_ setq
              (if ssIn (setq ssOut (acet-ss-remove ssIn ssOut)))
              ((lambda (i)
                 (while (setq e (ssname ssOut (setq i (1+ i))))
                   (or (eq e o) (vl-catch-all-apply (function entdel) (list e)))
                 ) ;_ while
               ) ;_ lambda
               -1
              )
              (entdel o-)
         ) ;_ and
        )
      ) ;_ cond
 ) ;_ and
 (*error* nil)
 (princ)
) ;_ defun

M.R.

 

 

 

 

 

Thank you very much Marko,

I’m not a developer but I wanted to know not to integrate the extrim.lsp with the other lisp file such that it works irrespective with what we have as extrim.lsp in our machines

I mean to have one lisp file to do all the work without the need to consider the extrim.lsp

Best

Jamal