Author Topic: small pieces to remove  (Read 7177 times)

0 Members and 1 Guest are viewing this topic.

domenicomaria

  • Swamp Rat
  • Posts: 723
small pieces to remove
« on: November 14, 2022, 07:07:13 AM »
Is there anyone who has already written a Lisp routine to remove
all fuchsia colored pieces that are shorter of a certain size ?
(selecting all objects together)
« Last Edit: November 14, 2022, 07:55:22 AM by domenicomaria »

dexus

  • Newt
  • Posts: 196
Re: small pieces to remove
« Reply #1 on: November 14, 2022, 10:13:41 AM »
You can do it with normal autocad functions:
PEDIT => MULTIPLE => Select objects => JOIN => Type in fuzz, which is the "certain size" => ENTER => ENTER

domenicomaria

  • Swamp Rat
  • Posts: 723
Re: small pieces to remove
« Reply #2 on: November 14, 2022, 12:10:50 PM »
but i don't want JOIN ...
i want ONLY REMOVE small pieces ...

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1451
  • Marco
Re: small pieces to remove
« Reply #3 on: November 14, 2022, 01:06:38 PM »
but i don't want JOIN ...
i want ONLY REMOVE small pieces ...
Join then Explode...

domenicomaria

  • Swamp Rat
  • Posts: 723
Re: small pieces to remove
« Reply #4 on: November 15, 2022, 01:07:00 AM »
but if I already have polylines before the JOIN command, why do I have to explode them?

domenicomaria

  • Swamp Rat
  • Posts: 723
Re: small pieces to remove
« Reply #5 on: November 15, 2022, 02:48:11 AM »
this is what i am looking for

It's Alive!

  • Retired
  • Needs a day job
  • Posts: 8659
  • AKA Daniel
Re: small pieces to remove
« Reply #6 on: November 15, 2022, 03:29:29 AM »
Well, that looks like fun :)
Maybe break the curves at every intersection, erase the plines that are under a certain length, rejoin where applicable.
Don’t know if there’s an activeX getSplitCurves

domenicomaria

  • Swamp Rat
  • Posts: 723
Re: small pieces to remove
« Reply #7 on: November 15, 2022, 05:33:44 AM »
it's not as simple as it may seem ...

nekonihonjin

  • Newt
  • Posts: 103
Re: small pieces to remove
« Reply #8 on: November 15, 2022, 09:44:56 AM »
Just an idea to start from:


break objects like this
http://www.theswamp.org/index.php?topic=10370.msg132035#msg132035

then for the broken segments evaluate if one of them is shorter than certain size, erase that segment and keep the other, then join the remnants

Code: [Select]
;;;=======================[ BreakObjects.lsp ]==============================
;;; Author: Copyright© 2006,2007 Charles Alan Butler
;;; Contact @  www.TheSwamp.org
;;; Version:  1.3 April 9,2007
;;; Globalization by XANADU - www.xanadu.cz
;;; Purpose: Break All selected objects
;;;    permitted objects are lines, lwplines, plines, splines,
;;;    ellipse, circles & arcs
;;;                           
;;;  Function  c:BreakAll -      Break all objects selected
;;;  Function  c:BreakwObjects - Break many objects with a single object
;;;  Function  c:BreakObject -   Break a single object with many objects
;;;  Function  c:BreakWith -     Break selected objects with other selected objects
;;;  Function  c:BreakTouching - Break objects touching the single Break object
;;;  Function  c:BreakSelected - Break selected objects with any  objects that touch it
;;;                   
;;; Sub_Routines:     
;;;    break_with     
;;;    ssget->vla-list
;;;    list->3pair     
;;;    onlockedlayer   
;;;    get_interpts Return a list of intersect points
;;;    break_obj  Break entity at break points in list
;;; Requirements: objects must have the same z-value
;;; Restrictions: Does not Break objects on locked layers
;;; Returns:  none
;;;=====================================================================
;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED     ;
;;;   WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR  ;
;;;   PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.            ;
;;;                                                                    ;
;;;  You are hereby granted permission to use, copy and modify this    ;
;;;  software without charge, provided you do so exclusively for       ;
;;;  your own use or for use by others in your organization in the     ;
;;;  performance of their normal duties, and provided further that     ;
;;;  the above copyright notice appears in all copies and both that    ;
;;;  copyright notice and the limited warranty and restricted rights   ;
;;;  notice below appear in all supporting documentation.              ;
;;;=====================================================================


;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;               M A I N   S U B R O U T I N E                   
;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun break_with (ss2brk ss2brkwith self / cmd intpts lst masterlist ss ssobjs
                   onlockedlayer ssget->vla-list list->3pair
                   get_interpts break_obj
                  )
  ;; ss2brk     selection set to break
  ;; ss2brkwith selection set to use as break points
  ;; self       when true will allow an object to break itself
  ;;            note that plined will break at each vertex
  (vl-load-com)


;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;                S U B   F U N C T I O N S                     
;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

  (defun onlockedlayer (ename / entlst)
    (setq entlst (tblsearch "LAYER" (cdr (assoc 8 (entget ename)))))
    (= 4 (logand 4 (cdr (assoc 70 entlst))))
  )
 
  (defun ssget->vla-list (ss / i ename lst)
    (setq i -1)
    (while (setq ename (ssname ss (setq i (1+ i))))
      (setq lst (cons (vlax-ename->vla-object ename) lst))
    )
    lst
  )

  (defun list->3pair (old / new)
    (while (setq new (cons (list (car old) (cadr old) (caddr old)) new)
                 old (cdddr old))
    )
    (reverse new)
  )
 
;;==============================================================
;;  return a list of intersect points
;;==============================================================
(defun get_interpts (obj1 obj2 / iplist)
  (if (not (vl-catch-all-error-p
             (setq iplist (vl-catch-all-apply
                            'vlax-safearray->list
                            (list
                              (vlax-variant-value
                                (vla-intersectwith obj1 obj2 acextendnone)
                              ))))))
    iplist
  )
)


;;==============================================================
;;  Break entity at break points in list
;;==============================================================
(defun break_obj (ent brkptlst / brkobjlst en enttype maxparam closedobj
                  minparam obj obj2break p1param p2 p2param
                 )

  (setq obj2break ent
        brkobjlst (list ent)
        enttype   (cdr (assoc 0 (entget ent)))
  )

  (foreach brkpt brkptlst
    ;;  get last entity created via break in case multiple breaks
    (if brkobjlst
      (progn
        ;;  if pt not on object x, switch objects
        (if (not (numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list obj2break brkpt)))
            )
          (foreach obj brkobjlst ; find the one that pt is on
            (if (numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list obj brkpt)))
              (setq obj2break obj) ; switch objects
            )
          )
        )
      )
    )

    ;;  Handle any objects that can not be used with the Break Command
    ;;  using one point, gap of 0.000001 is used
    (cond
      ((and (= "SPLINE" enttype) ; only closed splines
            (vlax-curve-isclosed obj2break))
       (setq p1param (vlax-curve-getparamatpoint obj2break brkpt)
             p2      (vlax-curve-getpointatparam obj2break (+ p1param 0.000001))
       )
       (command "._break" obj2break "_non" (trans brkpt 0 1) "_non" (trans p2 0 1))
      )
      ((= "CIRCLE" enttype) ; break the circle
       (setq p1param (vlax-curve-getparamatpoint obj2break brkpt)
             p2      (vlax-curve-getpointatparam obj2break (+ p1param 0.000001))
       )
       (command "._break" obj2break "_non" (trans brkpt 0 1) "_non" (trans p2 0 1))
       (setq enttype "ARC")
      )
      ((and (= "ELLIPSE" enttype) ; only closed ellipse
            (vlax-curve-isclosed obj2break))
       ;;  Break the ellipse, code borrowed from Joe Burke  6/6/2005
       (setq p1param  (vlax-curve-getparamatpoint obj2break brkpt)
             p2param  (+ p1param 0.000001)
             minparam (min p1param p2param)
             maxparam (max p1param p2param)
             obj      (vlax-ename->vla-object obj2break)
       )
       (vlax-put obj 'startparameter maxparam)
       (vlax-put obj 'endparameter (+ minparam (* pi 2)))
      )
     
      ;;==================================
      (t  ;   Objects that can be broken     
       (setq closedobj (vlax-curve-isclosed obj2break))
       (command "._break" obj2break "_non" (trans brkpt 0 1) "_non" (trans brkpt 0 1))
       (if (not closedobj) ; new object was created
           (setq brkobjlst (cons (entlast) brkobjlst))
       )
      )
    )
  )
)


 
  ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  ;;                   S T A R T   H E R E                         
  ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    (if (and ss2brk ss2brkwith)
    (progn
      ;;  CREATE a list of entity & it's break points
      (foreach obj (ssget->vla-list ss2brk) ; check each object in ss2brk
        (if (not (onlockedlayer (vlax-vla-object->ename obj)))
          (progn
            (setq lst nil)
            ;; check for break pts with other objects in ss2brkwith
            (foreach intobj (ssget->vla-list ss2brkwith)
              (if (and (or self (not (equal obj intobj)))
                       (setq intpts (get_interpts obj intobj))
                  )
                (setq lst (append (list->3pair intpts) lst)) ; entity w/ break points
              )
            )
            (if lst
              (setq masterlist (cons (cons (vlax-vla-object->ename obj) lst) masterlist))
            )
          )
        )
      )
      ;;  masterlist = ((ent brkpts)(ent brkpts)...)
      (if masterlist
        (foreach obj2brk masterlist
          (break_obj (car obj2brk) (cdr obj2brk))
        )
      )
      )
  )
;;==============================================================

)
(prompt "\nBreak Routines Loaded, Enter BreakAll, BreakEnt, or BreakWith to run.")
(princ)

(defun c:test (/ cmd ss1 ss2)
 
  ;;  get all objects touching entities in the sscross
  ;;  limited obj types to "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
    (setq min_d (getreal "\nMinimun length to keep line: "))
  (defun gettouching (sscros / ss lst lstb lstc objl)
    (and
      (setq lstb (vl-remove-if 'listp (mapcar 'cadr (ssnamex sscros)))
            objl (mapcar 'vlax-ename->vla-object lstb)
      )
      (setq
        ss (ssget "_A" (list (cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")
                             (cons 410 (getvar "ctab"))))
      )
      (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      (setq lst (mapcar 'vlax-ename->vla-object lst))
      (mapcar
        '(lambda (x)
           (mapcar
             '(lambda (y)
                (if (not
                      (vl-catch-all-error-p
                        (vl-catch-all-apply
                          '(lambda ()
                             (vlax-safearray->list
                               (vlax-variant-value
                                 (vla-intersectwith y x acextendnone)
                               ))))))
                  (setq lstc (cons (vlax-vla-object->ename x) lstc))
                )
              ) objl)
         ) lst)
    )
    lstc
  )

  (command "._undo" "_begin")
  (setq cmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setq Lastent (entlast));last end mark
  (setq ss1 (ssadd))
  (setq ss_br (ssadd))
  ;;  get objects to break
  (if (and (not (prompt "\nSelect object(s) to break with & press enter: "))
           (setq ss2 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
           (mapcar '(lambda (x) (ssadd x ss1)) (gettouching ss2))
      )
    (break_with ss2 ss1 nil) ; ss2break ss2breakwith (flag nil = not to break with self)
  )

  (if (setq en (entnext LastEnt))
    (while en
      (ssadd en ss_br)
      (setq en (entnext en))
    )
  )

  (setq i 0)
  (while (setq bk_l (ssname ss_br i))
     (setq bk_lv (vlax-ename->vla-object bk_l))
     (setq len (vla-get-length bk_lv))
     (if (< len min_d)
         (entdel bk_l)
     );if
     (princ len)
     (princ "  ")
     (setq i (1+ i))
   );while
 
    (setq j 0)
  (while (setq or_l (ssname ss2 j))
     (setq or_lv (vlax-ename->vla-object or_l))
     (setq len (vla-get-length or_lv))
     (if (< len min_d)
         (entdel or_l)
     );if
     (princ len)
     (princ "  ")
     (setq j (1+ j))
   );while

  (if (setq en (entnext LastEnt))
    (while en
      (ssadd en ss_lt)
      (setq en (entnext en))
    )
  )


 (initcommandversion)(command "_.join" ss_lt "")

  (setvar "CMDECHO" cmd)
  (command "._undo" "_end")
  (princ)
)



fails if there is an arc involved in the lines.
it's yet to be fixed to evaluate when the object is an arc, it will not work vla-get-length, since the arc has the arclength property, instead of length.
« Last Edit: November 15, 2022, 10:54:24 AM by nekonihonjin »

mhupp

  • Bull Frog
  • Posts: 250
Re: small pieces to remove
« Reply #9 on: November 15, 2022, 11:48:51 AM »
Trim entity picking endpoint closest to intersection?

It's Alive!

  • Retired
  • Needs a day job
  • Posts: 8659
  • AKA Daniel
Re: small pieces to remove
« Reply #10 on: November 15, 2022, 05:28:52 PM »
this kinda works, maybe someone can translate the idea to lisp

Code - C: [Select]
  1.     static Acad::ErrorStatus postToDatabase(AcDbObjectId& Id, AcDbEntity* pEnt, AcDbDatabase* pDb)
  2.     {
  3.         if (pDb == nullptr)
  4.             return Acad::eInvalidInput;
  5.         if (pEnt == nullptr)
  6.             return Acad::eInvalidInput;
  7.         Acad::ErrorStatus es = eOk;
  8.         AcDbBlockTableRecordPointer pCurSpace(pDb->currentSpaceId(), AcDb::kForWrite);
  9.         es = pCurSpace.openStatus();
  10.         if (es == eOk)
  11.         {
  12.             es = pCurSpace->appendAcDbEntity(Id, pEnt);
  13.         }
  14.         return es;
  15.     }
  16.  
  17.     static Acad::ErrorStatus selectPlines(AcDbObjectIdArray& ids)
  18.     {
  19.         struct resbuf* filter = acutBuildList(RTDXF0, ACRX_T("LWPOLYLINE"), RTNONE);
  20.         const ACHAR* prompt[] = { ACRX_T("\nSelect PLINES: "), ACRX_T("\nRemove PLINES: ") };
  21.         const ACHAR* mode = ACRX_T(":$");
  22.         ads_name ss = { 0L };
  23.         if (acedSSGet(mode, prompt, NULL, filter, ss) == RTNORM)
  24.         {
  25.             if (auto es = acedGetCurrentSelectionSet(ids); es != eOk)
  26.             {
  27.                 acutPrintf(_T("\nSelection error  = %ls :"), acadErrorStatusText(es));
  28.                 return es;
  29.             }
  30.             acutRelRb(filter);
  31.             acedSSFree(ss);
  32.         }
  33.         return eOk;
  34.     }
  35.  
  36.  
  37.     static std::map<AcDbObjectId, AcGePoint3dArray> findObjects(AcDbObjectIdArray& plineIds, double len)
  38.     {
  39.         std::map<AcDbObjectId, AcGePoint3dArray> objs;
  40.         for (const auto& idl : plineIds)
  41.         {
  42.             AcDbObjectPointer<AcDbPolyline> pleft(idl);
  43.             for (const auto& idr : plineIds)
  44.             {
  45.                 if(idr == idl)
  46.                     continue;
  47.                 AcGePoint3dArray hitPoints;
  48.                 AcDbObjectPointer<AcDbPolyline> pright(idr);
  49.                 if (pleft->intersectWith(pright, AcDb::kOnBothOperands, hitPoints) == eOk)
  50.                 {
  51.                     for (const auto& pnt : hitPoints)
  52.                     {
  53.                         {
  54.                             double dist;
  55.                             if (pleft->getDistAtPoint(pnt, dist) == eOk)
  56.                             {
  57.                                 if (dist < len)
  58.                                     objs[idl].append(pnt);
  59.                             }
  60.                         }
  61.                         {
  62.                             AcDbPolylineUPtr pClone(static_cast<AcDbPolyline*>(pleft->clone()));
  63.                             pClone->reverseCurve();
  64.                             double dist;
  65.                             if (pClone->getDistAtPoint(pnt, dist) == eOk)
  66.                             {
  67.                                 if (dist < len)
  68.                                     objs[idl].append(pnt);
  69.                             }
  70.                         }
  71.                     }
  72.                 }
  73.             }
  74.         }
  75.         return objs;
  76.     }
  77.  
  78.     static void tHeChopper(std::map<AcDbObjectId, AcGePoint3dArray> &objs, double len)
  79.     {
  80.         AcDbDatabase* pDb = acdbHostApplicationServices()->workingDatabase();
  81.         for (auto& item : objs)
  82.         {
  83.             AcDbVoidPtrArray pSubents;
  84.             AcDbObjectPointer<AcDbPolyline> pLine(item.first);
  85.             if (pLine->getSplitCurves(item.second, pSubents) == eOk)
  86.             {
  87.                 for (auto vd : pSubents)
  88.                 {
  89.                     AcDbCurveUPtr pCurve(static_cast<AcDbCurve*>(vd));
  90.                     if (pCurve == nullptr)
  91.                         continue;
  92.                     double ep;
  93.                     double dist;
  94.                     if (pCurve->getEndParam(ep) == eOk)
  95.                     {
  96.                         pCurve->getDistAtParam(ep, dist);
  97.                         if (dist > len)
  98.                         {
  99.                             AcDbObjectId nid;
  100.                             postToDatabase(nid, pCurve.get(), pDb);
  101.                         }
  102.                     }
  103.                 }
  104.             }
  105.         }
  106.         for (auto& item : objs)
  107.         {
  108.             AcDbObjectPointer<AcDbPolyline> pLine(item.first, AcDb::kForWrite);
  109.             pLine->erase();
  110.         }
  111.     }
  112.  
  113.     static void CArxTest_doit()
  114.     {
  115.         double len = 0;
  116.         acedGetReal(_T("\nEnter a length: "), &len);
  117.         AcDbObjectIdArray plineIds;
  118.         if (selectPlines(plineIds) != eOk)
  119.             return;
  120.         auto map = findObjects(plineIds, len);
  121.         tHeChopper(map, len);
  122.     }
  123.  

kdub_nz

  • Mesozoic keyThumper
  • SuperMod
  • Water Moccasin
  • Posts: 2120
  • class keyThumper<T>:ILazy<T>
Re: small pieces to remove
« Reply #11 on: November 15, 2022, 06:46:45 PM »
this kinda works, maybe someone can translate the idea to lisp

Code - C: [Select]
  1.     static Acad::ErrorStatus postToDatabase(AcDbObjectId& Id, AcDbEntity* pEnt, AcDbDatabase* pDb)
  2. // . . .
  3.  

nice
Called Kerry in my other life
Retired; but they dragged me back in !

I live at UTC + 13.00

---
some people complain about loading the dishwasher.
Sometimes the question is more important than the answer.

BIGAL

  • Swamp Rat
  • Posts: 1396
  • 40 + years of using Autocad
Re: small pieces to remove
« Reply #12 on: November 15, 2022, 06:51:16 PM »
Arx answer very nice.

Just a think about it do a "intersectwith" every object compared to another, then look for end points and if the overlap is not zero or a short amount then reset the correct end point to the intersection point.

A difficult problem.

A man who never made a mistake never made anything

It's Alive!

  • Retired
  • Needs a day job
  • Posts: 8659
  • AKA Daniel
Re: small pieces to remove
« Reply #13 on: November 15, 2022, 07:47:13 PM »
Arx answer very nice.

Just a think about it do a "intersectwith" every object compared to another, then look for end points and if the overlap is not zero or a short amount then reset the correct end point to the intersection point.

A difficult problem.

Hmmm, I guess I could have moved the end points instead of creating shorter copies and erasing the originals  :mrgreen:

domenicomaria

  • Swamp Rat
  • Posts: 723
Re: small pieces to remove
« Reply #14 on: November 16, 2022, 03:00:50 AM »
@Daniel

Daniel, forgive my ignorance.
I'm trying to figure out what you did.
I know the C language very little.
And I would like to know what getSplitCurves does


Can you explain it to me?
« Last Edit: November 16, 2022, 03:04:49 AM by domenicomaria »