TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: domenicomaria on November 14, 2022, 07:07:13 AM

Title: small pieces to remove
Post by: domenicomaria 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)
Title: Re: small pieces to remove
Post by: dexus 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
Title: Re: small pieces to remove
Post by: domenicomaria on November 14, 2022, 12:10:50 PM
but i don't want JOIN ...
i want ONLY REMOVE small pieces ...
Title: Re: small pieces to remove
Post by: Marc'Antonio Alessi on November 14, 2022, 01:06:38 PM
but i don't want JOIN ...
i want ONLY REMOVE small pieces ...
Join then Explode...
Title: Re: small pieces to remove
Post by: domenicomaria 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?
Title: Re: small pieces to remove
Post by: domenicomaria on November 15, 2022, 02:48:11 AM
this is what i am looking for
Title: Re: small pieces to remove
Post by: It's Alive! 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
Title: Re: small pieces to remove
Post by: domenicomaria on November 15, 2022, 05:33:44 AM
it's not as simple as it may seem ...
Title: Re: small pieces to remove
Post by: nekonihonjin 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.
Title: Re: small pieces to remove
Post by: mhupp on November 15, 2022, 11:48:51 AM
Trim entity picking endpoint closest to intersection?
Title: Re: small pieces to remove
Post by: It's Alive! 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.  
Title: Re: small pieces to remove
Post by: kdub_nz 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
Title: Re: small pieces to remove
Post by: BIGAL 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.

Title: Re: small pieces to remove
Post by: It's Alive! 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:
Title: Re: small pieces to remove
Post by: domenicomaria 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?
Title: Re: small pieces to remove
Post by: It's Alive! on November 16, 2022, 03:35:27 AM
Basically, splits the curve into segments, at each of the points in the argument
https://help.autodesk.com/view/OARX/2023/ENU/?guid=OARX-RefGuide-AcDbCurve__getSplitCurves_AcGePoint3dArray__AcDbVoidPtrArray__const

I don’t think it’s available to lisp though. I think Bigal’s suggestion might be a better alternative, just move the end, instead of splitting it and deleting the short ends

Title: Re: small pieces to remove
Post by: DEVITG on November 16, 2022, 08:01:01 PM
@domenicomaria Just do a google , and get it

Quote
https://www.google.com/search?q=getSplitCurves&sourceid=chrome&ie=UTF-8

Could you, please upload your sample dwg?
Title: Re: small pieces to remove
Post by: domenicomaria on November 17, 2022, 12:16:11 AM
@ Daniel & DEVITG

Thank you
Title: Re: small pieces to remove
Post by: It's Alive! on November 17, 2022, 01:23:26 AM
mine fails in some cases
Title: Re: small pieces to remove
Post by: It's Alive! on November 17, 2022, 02:57:37 AM
fixed it, getsplitcurves wants the points sorted  :mrgreen:
added
Code - C: [Select]
  1.             std::sort(item.second.begin(), item.second.end(), [&](const auto& a, const auto& b) -> bool
  2.             {
  3.                 double da, db;
  4.                 pLine->getDistAtPoint(a, da);
  5.                 pLine->getDistAtPoint(b, db);
  6.                 return da < db;
  7.             });
  8.  

i attached the source and a binary for autocad 2021-2023.
the command is CHOPPER  :lol:
Title: Re: small pieces to remove
Post by: It's Alive! on November 17, 2022, 03:01:13 AM
BTW, the sort is a lambda expression in c++, just in case I can convert you to the darkside  :devilsidesmile:
Title: Re: small pieces to remove
Post by: domenicomaria on November 17, 2022, 03:37:24 AM
Daniel, you are great !

I want try to translate it into vlisp
Title: Re: small pieces to remove
Post by: xdcad on November 22, 2023, 05:29:08 PM
@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?

Now you can try xdrx_curve_getSplitCurves
Title: Re: small pieces to remove
Post by: xdcad on November 22, 2023, 06:04:56 PM
Daniel, you are great !

I want try to translate it into vlisp

Code - Auto/Visual Lisp: [Select]
  1. (defun c:tt ()
  2.   (defun _process-shortline (ss)
  3.     (mapcar '(lambda (x)
  4.                (if (< (xdrx-getpropertyvalue x "length") len)
  5.                  (xdrx-entity-delete x)
  6.                )
  7.              )
  8.             (xdrx-pickset->ents ss)
  9.     )
  10.   )
  11.   (if (and (setq len (getreal "\nEnter shortest distance <exit>:"))
  12.            (setq ss (xdrx-ssget
  13.                       "\nSelect the curve to be processed <Exit>:"
  14.                       '((0 . "*line,arc,ellipse"))
  15.                     )
  16.            )
  17.       )
  18.     (progn
  19.       (xdrx-begin)
  20.       (setq ents (xdrx-pickset->ents ss))
  21.       (while (cdr ents)
  22.         (setq e1 (car ents))
  23.         (mapcar
  24.           '(lambda (x)
  25.              (if (and (setq ints (xdrx-entity-intersectwith e1 x))
  26.                       (setq ss1 (xdrx-curve-getsplitcurves e1 ints))
  27.                  )
  28.                (_process-shortline ss1)
  29.              )
  30.            )
  31.           (cdr ents)
  32.         ) ;_ end of mapcar
  33.         (setq ents (cdr ents))
  34.       ) ;_ end of while
  35.       (xdrx-end)
  36.     )
  37.   ) ;_ end of if
  38.   (princ)
  39. )
  40.  
Title: Re: small pieces to remove
Post by: domenicomaria on November 23, 2023, 12:34:54 AM
@xdcad
... great !
Title: Re: small pieces to remove
Post by: domenicomaria on November 23, 2023, 05:01:22 AM
https://www.theswamp.org/index.php?topic=58764.0
Title: Re: small pieces to remove
Post by: ribarm on November 23, 2023, 05:22:59 AM
I think there should be no lacks with ARCs when using CAB's BreakObjects.lsp that I modified and added (c:BreakAll-nogaps)... After breaking it's only needed to remove small pieces with length tolerance... I'll attach my version of BreakObjects.lsp if you or someone else is interested...
Title: Re: small pieces to remove
Post by: BIGAL on November 23, 2023, 05:54:45 PM
Like Ribarm used Cab's breakall, I used recently for a task, then just do a ssget and look at length of objects if short then delete.
Title: Re: small pieces to remove
Post by: ribarm on November 24, 2023, 04:24:55 AM
FYI,
I've changed posted *.lsp as I founded some lacks and I brefly remedy *.lsp...
You can find it here : https://www.theswamp.org/index.php?topic=57930.msg617266#msg617266

Regards,
HTH.
M.R.
Title: Re: small pieces to remove
Post by: domenicomaria on November 24, 2023, 05:25:06 AM
Like Ribarm used Cab's breakall, I used recently for a task, then just do a ssget and look at length of objects if short then delete.

but Cab's breakall will break all curves at all intersections!

So after that the curves are all broken !

And then if you join them again,
in each curve there will be some more vertices
where there were intersections...!

Or is what I'm saying incorrect?
Title: Re: small pieces to remove
Post by: dexus on November 24, 2023, 06:10:33 AM
Like Ribarm used Cab's breakall, I used recently for a task, then just do a ssget and look at length of objects if short then delete.

but Cab's breakall will break all curves at all intersections!

So after that the curves are all broken !

And then if you join them again,
in each curve there will be some more vertices
where there were intersections...!

Or is what I'm saying incorrect?
You can use Purge-pline from gile to remove the unnecessary vertices again.
https://www.theswamp.org/index.php?topic=19865.msg244892#msg244892
Title: Re: small pieces to remove
Post by: domenicomaria on November 24, 2023, 08:18:41 AM
You can use Purge-pline from gile to remove the unnecessary vertices again.
https://www.theswamp.org/index.php?topic=19865.msg244892#msg244892
ok, but the best thing, however,
is not to break the curves when it is not necessary ...
Title: Re: small pieces to remove
Post by: domenicomaria on November 24, 2023, 10:47:46 AM
Code - Auto/Visual Lisp: [Select]
  1. (defun C:BREAK-ON-PT ( / x-en x-es x-pt)
  2.    (and
  3.       (setq x-es (xdrx-entsel "\nselect the curve to break <exit> : " '((0 . "*line,arc,ellipse"))))
  4.       (setq x-en (car x-es) )
  5.       (setq x-pt (getpoint "\nbreak point <exit> : ") )
  6.       (xdrx-curve-getsplitcurves x-en (list x-pt) )
  7.    )
  8. )
  9. (defun C:BP () (C:BREAK-ON-PT) )

an alternative (that could be easily implemented) to (command "break" ...)
Title: Re: small pieces to remove
Post by: xdcad on November 24, 2023, 07:03:48 PM
Code - Auto/Visual Lisp: [Select]
  1. (defun C:BREAK-ON-PT ( / x-en x-es x-pt)
  2.    (and
  3.       (setq x-es (xdrx-entsel "\nselect the curve to break <exit> : " '((0 . "*line,arc,ellipse"))))
  4.       (setq x-en (car x-es) )
  5.       (setq x-pt (getpoint "\nbreak point <exit> : ") )
  6.       (xdrx-curve-getsplitcurves x-en (list x-pt) )
  7.    )
  8. )
  9. (defun C:BP () (C:BREAK-ON-PT) )

an alternative (that could be easily implemented) to (command "break" ...)

For the situation of processing a curve in the loop

1. If you only call xdrx-curve-getsplitcurves, the curve itself will be interrupted at the intersection, as shown below:

(https://www.theswamp.org/index.php?action=dlattach;topic=57930.0;attach=41580;image)

2. Calling xdrx-curve-getsplitcurves will generate a processed selection set, in which we delete the shortest line that meets the conditions, and then join the remaining disconnected lines, as shown below, and the problem will be solved.

(https://www.theswamp.org/index.php?action=dlattach;topic=57930.0;attach=41579;image)

Test code:

Code - Auto/Visual Lisp: [Select]
  1. (defun c:tt ()
  2.   (if (and (setq ss (xdrx-ssget
  3.                       "\nSelect Curve<Quit>:"
  4.                       '((0 . "*line,arc,ellipse"))
  5.                     )
  6.            )
  7.            (setq e (xdrx-entsel
  8.                      "\nPick Test Curve<Quit>:"
  9.                      '((0 . "*line,arc,ellipse"))
  10.                    )
  11.            )
  12.       )
  13.     (progn
  14.       (setq e  (car e)
  15.             ss (ssdel e ss)
  16.       )
  17.       (if (setq ints (xdrx-entity-intersectwith e ss))
  18.         (progn
  19.           (setq ss1 (xdrx-curve-getsplitcurves e ints))
  20.           (mapcar '(lambda (x)
  21.                      (if (< (xdrx-getpropertyvalue x "length") 200.0);;Erease Short Line
  22.                        (xdrx-entity-delete x)
  23.                      )
  24.                    )
  25.                   (xdrx-pickset->ents ss1)
  26.           )
  27.           (xdrx-curve-join ss1);;Join the interrupted curves together again
  28.         )
  29.       )
  30.     )
  31.   )
  32.   (princ)
  33. )

Title: Re: small pieces to remove
Post by: xdcad on November 24, 2023, 07:09:28 PM
Code - Auto/Visual Lisp: [Select]
  1. (defun C:BREAK-ON-PT ( / x-en x-es x-pt)
  2.    (and
  3.       (setq x-es (xdrx-entsel "\nselect the curve to break <exit> : " '((0 . "*line,arc,ellipse"))))
  4.       (setq x-en (car x-es) )
  5.       (setq x-pt (getpoint "\nbreak point <exit> : ") )
  6.       (xdrx-curve-getsplitcurves x-en (list x-pt) )
  7.    )
  8. )
  9. (defun C:BP () (C:BREAK-ON-PT) )

an alternative (that could be easily implemented) to (command "break" ...)

This is the code used by AUTOCAD's own internal BREAK command.
It is just the process of translating ARX using LISP.
Title: Re: small pieces to remove
Post by: It's Alive! on November 24, 2023, 07:18:06 PM
Maybe xdrx-curve-getsplitcurves can return lists to be used in entmake instead of clobbering the original
Title: Re: small pieces to remove
Post by: xdcad on November 24, 2023, 07:35:28 PM
Maybe xdrx-curve-getsplitcurves can return lists to be used in entmake instead of clobbering the original

thanks.....

I don't quite understand what you mean.

(xdrx-curve-getsplitcurves e pnts)

returned is the selection set of newly generated entities after the curve is interrupted by points.

What do you mean by destroying the original entmake List?
Title: Re: small pieces to remove
Post by: It's Alive! on November 24, 2023, 08:01:02 PM
Never mind, I thought you were modifying the original
Title: Re: small pieces to remove
Post by: xdcad on November 24, 2023, 08:11:06 PM
Never mind, I thought you were modifying the original

thanks....


Oh, I see what you mean
What you mean is not to process the original curve, but to generate entget tables, and then let LISP generate them.

I feel like it's a little detoured,

If you want the original curve to remain unchanged, use the following before operation:

(setq after (xdrx-object-clone source))

Just generate a backup

If you don’t want to change the backup curve entity name or color,linetype.....
At once:
(xdrx-object-swapid after source)
(xdrx-enitty-matchprop source after)
Title: Re: small pieces to remove
Post by: It's Alive! on November 24, 2023, 08:24:53 PM
IMHO , the original should not be modified, it contradicts the documentation. functions should match the ARX docs as closely as possible

- either, add the new objects to the database so they can be deleted later, or
- provide the data to generate the new objects.

Having to call (xdrx-object-swapid after source) or (xdrx-enitty-matchprop source after) seems very detoured, coming from an ARX perspective

just my opinion though
Title: Re: small pieces to remove
Post by: domenicomaria on November 24, 2023, 11:48:36 PM
Maybe xdrx-curve-getsplitcurves can return lists to be used in entmake instead of clobbering the original
actually another function like xdrx-curve-getsplitcurves
could be useful by returning the informations to create (with entmake)
the pieces of curve defined by the list of intersections ...

...so the user could first check the data and then decide what to do...

... and this seems logically correct to me ...
Title: Re: small pieces to remove
Post by: xdcad on November 25, 2023, 12:26:59 AM
IMHO , the original should not be modified, it contradicts the documentation. functions should match the ARX docs as closely as possible

- either, add the new objects to the database so they can be deleted later, or
- provide the data to generate the new objects.

Having to call (xdrx-object-swapid after source) or (xdrx-enitty-matchprop source after) seems very detoured, coming from an ARX perspective

just my opinion though

Thanks for the suggestion
In the next version of API, xdrx-curve-getsplitcurves will add a parameter t
will return the AcGe geometry entity list.

Code - Auto/Visual Lisp: [Select]
  1. Select object: <Entity name: 1a0f34b1dc0>
  2.  
  3. Command: (setq ints (xdrx-entity-intersectwith e ss))
  4. ((3607.04 1761.67 0.0) (3742.7 1497.1 0.0) (3647.68 1217.72 0.0))
  5.  
  6. Command: (setq ents (xdrx-curve-getsplitcurves e ints t))
  7. (<Entity name: 1a0af6cbc50> <Entity name: 1a0af6cbe70> <Entity name: 1a0af6cc0f0> <Entity name: 1a0af6cbb70>)
  8.  
  9. Command: (mapcar '(lambda(x)(xdrx-object-isa x)) ents)
  10. ("kCompositeCrv3d" "kCompositeCrv3d" "kCompositeCrv3d" "kCompositeCrv3d")
  11.  
  12. Command: (mapcar '(lambda(x)(xdrx-getpropertyvalue x "length")) ents)
  13. (861.66 306.442 301.473 312.489)
  14.  
  15. Command: (mapcar '(lambda(x)(xdrx-getpropertyvalue x "area" "length")) ents)
  16. ((59123.0 861.66) (6409.2 306.442) (5277.28 301.473) (5708.8 312.489))
  17.  
Title: Re: small pieces to remove
Post by: It's Alive! on November 25, 2023, 02:22:29 AM
that's so cool!  8-)
Title: Re: small pieces to remove
Post by: ribarm on November 27, 2023, 01:18:42 PM
I've updated CAB's BreakObjects.lsp...
You can find it here :
https://www.theswamp.org/index.php?topic=57930.msg617266#msg617266

And here :
https://www.cadtutor.net/forum/files/file/51-breakobjectslsp/

And for gift there is in this attachment flashpoly.lsp that is closely connected with (c:BreakAll-nogaps)...