ERASE polyline or OBJETC OUTSIDE MULTI CONTOUR

[KARDOLITO89]

 

Por favor, podemos ayudar a convertir este punto para poder seleccionar varios contornos (polilínea) y mantener los segmentos que se intersecan con una línea que cruza todos los contornos.

 

 

 

 

 

 

 

 

 

Edited October 19, 2018 by KARDOLITO89

[KARDOLITO89]

 

 

; Required Express tools
; OutSide Contour Delete with Extrim
; Found at http://forums.augi.com/showthread.php?t=55056
(defun C:OCD (  / en ss lst ssall bbox)
(vl-load-com)
  (if (and (setq en (car(entsel "\nSelect contour (polyline): ")))
           (wcmatch (cdr(assoc 0 (entget en))) "*POLYLINE"))
    (progn
      (setq bbox (ACET-ENT-GEOMEXTENTS en))
      (setq bbox (mapcar '(lambda(x)(trans x 0 1)) bbox))
      (setq lst (ACET-GEOM-OBJECT-POINT-LIST en 1e-3))
      (ACET-SS-ZOOM-EXTENTS (ACET-LIST-TO-SS (list en)))
      (command "_.Zoom" "0.95x")
      (if (null etrim)(load "extrim.lsp"))
      (etrim en (polar
                  (car bbox)
                  (angle (car bbox)(cadr bbox))
                  (* (distance (car bbox)(cadr bbox)) 1.1)))
      (if (and
            (setq ss (ssget "_CP" lst))
            (setq ssall (ssget "_X" (list (assoc 410 (entget en)))))
           )
        (progn
          (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
          (foreach e1 lst (ssdel e1 ssall))
          (ACET-SS-ENTDEL ssall)
          )
        )
      )
    )
  )
(princ "\nType OCD to start")
(princ)

Por favor, modifique esta luz para seleccionar el contorno múltiple y retener el segmento.

 

Edited October 19, 2018 by KARDOLITO89

[KARDOLITO89]

[Cad64]

I have merged your two threads together. Please don't create multiple threads asking the same question.

Also, this is an English speaking forum, so please post your questions in English.

 

Thank you

[marko_ribar]

Try this mod... Minimally tested...

 

; Required Express tools
; OutSide Contour Delete with Extrim
; Found at http://forums.augi.com/showthread.php?t=55056
; Modified for multiple contour processing by M.R.
(defun C:OCD ( / *error* LM:ConvexHull LM:Clockwise-p entnextparent adoc cmde sel i el en ss sss lst cp ssall bbox enx laylst elst fuzz )

  (vl-load-com)

  (defun *error* ( m )
    (if cmde
      (setvar 'cmdecho cmde)
    )
    (vla-endundomark adoc)
    (if m
      (prompt m)
    )
    (princ)
  )

  ;; Convex Hull  -  Lee Mac
  ;; Implements the Graham Scan Algorithm to return the Convex Hull of a list of points.

  (defun LM:ConvexHull ( lst / ch p0 )
      (cond
          (   (< (length lst) 4) lst)
          (   (setq p0 (car lst))
              (foreach p1 (cdr lst)
                  (if (or (< (cadr p1) (cadr p0))
                          (and (equal (cadr p1) (cadr p0) 1e-8) (< (car p1) (car p0)))
                      )
                      (setq p0 p1)
                  )
              )
              (setq lst (vl-remove p0 lst))
              (setq lst (append (list p0) lst))
              (setq lst
                  (vl-sort lst
                      (function
                          (lambda ( a b / c d )
                              (if (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-8)
                                  (< (distance p0 a) (distance p0 b))
                                  (< (if (equal c (* 2.0 pi) 1e-8) 0.0 c) (if (equal d (* 2.0 pi) 1e-8) 0.0 d))
                              )
                          )
                      )
                  )
              )
              (setq ch (list (cadr lst) (car lst)))
              (foreach pt (cddr lst)
                  (setq ch (cons pt ch))
                  (while (and (caddr ch) (LM:Clockwise-p (caddr ch) (cadr ch) pt))
                      (setq ch (cons pt (cddr ch)))
                  )
              )
              (reverse ch)
          )
      )
  )

  ;; Clockwise-p  -  Lee Mac
  ;; Returns T if p1,p2,p3 are clockwise oriented or collinear

  (defun LM:Clockwise-p ( p1 p2 p3 )
      (<  (-  (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
              (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
          )
          1e-8
      )
  )

  (defun entnextparent ( e )
    (while (and (setq e (entnext e)) (wcmatch (cdr (assoc 0 (entget e))) "ATTRIB,VERTEX,SEQEND")))
    e
  )

  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (if (= 8 (logand 8 (getvar 'undoctl)))
    (vla-endundomark adoc)
  )
  (setq cmde (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (prompt "\nSelect contour polylines: ")
  (while (not (setq sel (ssget "_:L" '((0 . "*POLYLINE") (-4 . "<or") (70 . 1) (70 . 129) (-4 . "or>")))))
    (prompt "\nEmpty sel.set... Retry selecting again...")
  )
  (if (tblsearch "LAYER" "temp_layer")
    (progn
      (prompt "\nLayer \"temp_layer\" already present in active document... Please delete this layer as it is used by this routine and restart OCD again...")
      (exit)
    )
  )
  (if (null etrim) (load "extrim.lsp"))
  (initget 6)
  (setq fuzz (getdist "\nPick or specify fuzz distance for interpolation of reference polyline(s) <0.5> : "))
  (if (null fuzz)
    (setq fuzz 0.5)
  )
  (repeat (setq i (sslength sel))
    (if laylst
      (progn
        (setq el (entlast))
        (vl-cmdf "_.PASTECLIP" "_non" '(0.0 0.0 0.0))
        (while (setq el (entnextparent el))
          (setq elst (cons el elst))
        )
      )
    )
    (vla-startundomark adoc)
    (setq en (ssname sel (setq i (1- i))))
    (setq bbox (ACET-ENT-GEOMEXTENTS en))
    (setq bbox (mapcar '(lambda ( x ) (trans x 0 1)) bbox))
    (setq lst (ACET-GEOM-OBJECT-POINT-LIST en fuzz))
    (setq cp (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (car bbox) (cadr bbox)))
    (setq lst (mapcar '(lambda ( x ) (mapcar '+ cp (mapcar '* (mapcar '- x cp) (list 1.05 1.05 1.05)))) lst))
    (setq lst (LM:ConvexHull lst))
    (vl-cmdf "_.ZOOM" "_OB" en "")
    (vl-cmdf "_.ZOOM" "0.75x")
    (etrim en (polar (car bbox) (angle (car bbox) (cadr bbox)) (* (distance (car bbox) (cadr bbox)) 1.1)))
    (vl-cmdf "_.ZOOM" "_P")
    (vl-cmdf "_.ZOOM" "_P")
    (if (setq ss (ssget "_CP" lst))
      (progn
        (setq sss (ssadd))
        (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
          (setq enx (entget (vlax-vla-object->ename (vla-copy (vlax-ename->vla-object e)))))
          (setq laylst (cons (cdr (assoc 8 enx)) laylst))
          (entupd (cdr (assoc -1 (entmod (subst (cons 8 "temp_layer") (assoc 8 enx) enx)))))
          (ssadd (cdr (assoc -1 enx)) sss)
        )
      )
    )
    (vl-cmdf "_.COPYBASE" "_non" '(0.0 0.0 0.0) sss "")
    (vl-cmdf "_.UNDO" "_B")
  )
  (setq el (entlast))
  (vl-cmdf "_.PASTECLIP" "_non" '(0.0 0.0 0.0))
  (while (setq el (entnextparent el))
    (setq elst (cons el elst))
  )
  (setq ssall (ssget "_X" (list (cons 8 "~temp_layer"))))
  (ACET-SS-ENTDEL ssall)
  (mapcar '(lambda ( a b ) (entupd (cdr (assoc -1 (entmod (subst (cons 8 b) '(8 . "temp_layer") (entget a))))))) elst laylst)
  (vl-cmdf "_.PURGE" "_LA" "temp_layer" "_N")
  (*error* nil)
)

HTH., M.R.

Edited October 21, 2018 by marko_ribar

[ronjonp]

On 10/19/2018 at 5:45 PM, Cad64 said:

Also, this is an English speaking forum, so please post your questions in English.

 

Thank you

Have you heard of Google translate ? This is the world wide web after all. 

Edited October 21, 2018 by ronjonp
clickety for easy translation

[BIGAL]

google translate