Inside a polyline

[Jozi68]

Hi All,

I work in 2D. I need some simple .net code to delete everything outside a selected closed polyline. Also need to trim all lines that intersect with it.

Any ideas will be appreciated.

regards,

Jozi

[MiGo]

I have a .lsp routine I found called CookieCutter2 v1.0.lsp It isn't mine but I modified it as to always ask if the user wants to convert solids to lines as to correctly trim back to the enclosed poly lines. It isn't perfect for the trimming part so I suggest using EXTRIM command for the trimming and this for the erasing. Also I have the PROJMODE variable set to 2 If you have it set to 0 or 1 you can get yourself into trouble with elevations.

CookieCutter2 v1.0.lsp

[CALCAD]

Jozi68,

Here are a couple of short programs, if you are still looking. They are simple and the error traps could use some development. If you find them useful, let me know and I'll finish the error trapping.

 

; tio.lsp - Trim Inside or Outside of closed polyline.
;           For lightweight closed polylines only.
;           The fence location sets the distance (inside
;           or outside) from the polyline to the offset
;           that defines the fence.

(defun findver (entname / verlst lst i)
(setq verlst nil)
(setq i 0)
(setq lst (entget entname))
(repeat (length lst)
(if (= (car (nth i lst)) 10)
 (setq verlst (append verlst (list (cdr (nth i lst)))))
)
(setq i (1+ i))
)
verlst
)

(defun c:tio (/ *ERROR* lwp floc fen fset ff)

(defun *ERROR* (msg)
 (setvar "CMDECHO" 1)
 (setvar "OSMODE" osave)
 (princ)
)

(setvar "CMDECHO" 0)
(setq osave (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq lwp (car (entsel "\n Pick polyline")))
(redraw lwp 3)
(setq floc (getpoint "\n Pick fence location"))
(command "OFFSET" "T" lwp floc "")
(setq fen (entlast))
(setq fset (findver fen))
(entdel fen)
(setq ff (car fset))
(setq fset (append fset (list ff)))
(command "TRIM" lwp "" "F" fset "" "")
(setvar "OSMODE" osave)
(setvar "CMDECHO" 1)
(redraw)
(princ)
)

 

; sdop.lsp - Select and Delete objects Outside of closed Polyline.
;            To trim lines projecting from closed region, first use
;            TIO, then run SDOP.

(defun findver (entname / verlst lst i)
(setq verlst nil)
(setq i 0)
(setq lst (entget entname))
(repeat (length lst)
(if (= (car (nth i lst)) 10)
 (setq verlst (append verlst (list (cdr (nth i lst)))))
)
(setq i (1+ i))
)
verlst
)

(defun c:sdop (/ *ERROR* lwp vset cset clen n cname)

(defun *ERROR* (msg)
 (setvar "CMDECHO" 1)
 (setq cset nil)
 (princ)
)

(setvar "CMDECHO" 0)
(setq lwp (car (entsel "\n Pick polyline")))
(setq vset (findver lwp))
(redraw lwp 3)
(command "SELECT" "OP" vset "" "")
(setq cset (ssget "P"))
(setq clen (sslength cset))
(setq n 0)
(repeat clen
(setq cname (ssname cset n))
(entdel cname)
(setq n (+ 1 n))
)
(setq cset nil)
(setvar "CMDECHO" 1)
(redraw)
(princ)
)

[nothingspecial]

Hello, CALCAD!

 

I am very interested in the functionality of your SDOP lisp. Unfortunately, I failed to get it work. I tried to select several different polylines and every time I got the following result:

 

Command: SDOP
Pick polyline
*Invalid selection*
Expects a point or 
Window/Last/Crossing/BOX/ALL/Fence/WPolygon/CPolygon/Group/Add/Remove/Multiple/P
revious/Undo/AUto/SIngle/SUbobject/Object
Select objects:

[VVA]

Latest version CookieCutter : CookieCutter2 - more fun with ET extrim

A little short programs:

SCWP - Select Contour Window Polygon

SCCP - Select Contour Crossing Polygon

;_Select Contour Window Polygon
(defun C:SCWP ()(SelectContour "_WP"))
;_Select Contour Crossing Polygon
(defun C:SCCP ()(SelectContour "_CP"))
(defun SelectContour ( opt / en ss lst)
(defun DTR (a)(* pi (/ a 180.0)))
(defun  lib:pt_extents (vlist / tmp)
(setq tmp (mapcar '(lambda (x) (vl-remove-if 'null x))
(mapcar '(lambda (what) (mapcar '(lambda (x) (nth what x)) vlist))
'(0 1 2))));_setq
 (list (mapcar '(lambda(x)(apply 'min x)) tmp)(mapcar '(lambda(x)(apply 'max x)) tmp)))
(defun lib:IsPtInView (pt / VCTR Y_Len SSZ X_Pix Y_Pix X_Len Lc Uc)
(setq pt (trans pt 0 1))
(setq VCTR (getvar "VIEWCTR") Y_Len (getvar "VIEWSIZE")
  SSZ (getvar "SCREENSIZE")
  X_Pix (car SSZ) Y_Pix (cadr SSZ)
  X_Len (* (/ X_Pix Y_Pix) Y_Len)
  Lc (polar VCTR (dtr 180.0) (* 0.5 X_Len))
  Uc (polar Lc 0.0 X_Len)
  Lc (polar Lc (dtr 270.0) (* 0.5 Y_Len))
  Uc (polar Uc (dtr 90.0) (* 0.5 Y_Len)))
(if (and (> (car pt) (car Lc))(< (car pt) (car Uc))
   (> (cadr pt) (cadr Lc))(< (cadr pt) (cadr Uc)))
  T nil))
(defun lib:Zoom2Lst( vlist / bl tr Lst OS)
(setq   Lst (lib:pt_extents vlist) bl (car Lst) tr (cadr Lst))
(if (not (and (lib:IsPtInView bl) (lib:IsPtInView tr)))
(progn  (setq OS (getvar "OSMODE"))(setvar "OSMODE" 0)
(command "_.Zoom" "_Window" (trans bl 0 1)(trans tr 0 1)
  "_.Zoom" "0.95x")
(setvar "OSMODE" OS) T) NIL))
(defun TraceObject (obj / typlst typ TracePline TraceACE TraceLine
                        TraceSpline TraceType1Pline
                         TraceType23Pline)
   (defun ZClosed (lst)
   (if (and (vlax-curve-isClosed obj)
      (not(equal (car lst)(last lst) 1e-6)))
     (append lst (list (car lst)))
     lst))
 (defun TracePline (obj / param endparam anginc tparam pt blg
                          ptlst delta inc arcparam flag)
   (setq param (vlax-curve-getStartParam obj)
         endparam (vlax-curve-getEndParam obj)
         anginc (* pi (/ 7.5 180.0)))
   (setq tparam param)
     (while (<= param endparam)
       (setq pt (vlax-curve-getPointAtParam obj param))
       (if (not (equal pt (car ptlst) 1e-12))
         (setq ptlst (cons pt ptlst)))
       (if  (and (/= param endparam)
           (setq blg (abs (vlax-invoke obj 'GetBulge param)))
           (/= 0 blg))
         (progn
           (setq delta (* 4 (atan blg)) ;included angle
                 inc (/ 1.0 (1+ (fix (/ delta anginc))))
                 arcparam (+ param inc))
           (while (< arcparam (1+ param))
             (setq pt (vlax-curve-getPointAtParam obj arcparam)
                   ptlst (cons pt ptlst)
                   arcparam (+ inc arcparam))))
       )
       (setq param (1+ param)))
   (if (and (apply 'and ptlst)
       (> (length ptlst) 1))
    (ZClosed (reverse ptlst)))) ;end
 (defun TraceACE (obj / startparam endparam anginc
                        delta div inc pt ptlst)
   (setq startparam (vlax-curve-getStartParam obj)
         endparam (vlax-curve-getEndParam obj)
         anginc (* pi (/ 5.0 180.0)))
   (if (equal endparam (* pi 2) 1e-12)
     (setq delta endparam)
     (setq delta (NormalAngle (- endparam startparam))))
   (setq div (1+ (fix (/ delta anginc)))
         inc (/ delta div))
   (while (or
       (< startparam endparam)
       (equal startparam endparam 1e-12))
     (setq pt (vlax-curve-getPointAtParam obj startparam)
           ptlst (cons pt ptlst)
           startparam (+ inc startparam)))
   (reverse ptlst)) ;end
 (defun TraceLine (obj)(list (vlax-get obj 'StartPoint)
       (vlax-get obj 'EndPoint)))
 (defun TraceSpline (obj / startparam endparam ncpts inc param
                           fd ptlst pt1 pt2 ang1 ang2 a)
   (setq startparam (vlax-curve-getStartParam obj)
         endparam (vlax-curve-getEndParam obj)
         ncpts (vlax-get obj 'NumberOfControlPoints)
         inc (/ (- endparam startparam) (* ncpts 7))
         param (+ inc startparam)
         fd (vlax-curve-getfirstderiv obj param)
         ptlst (cons (vlax-curve-getStartPoint obj) ptlst))
   (while (< param endparam)
     (setq pt1 (vlax-curve-getPointAtParam obj param)
           ang1 fd
           param (+ param inc)
           pt2 (vlax-curve-getPointAtParam obj param)
           fd (vlax-curve-getfirstderiv obj param)
           ang2 fd
           a (abs (3d_angw1w2 ang1 ang2)))
     (if (> a 0.00218166)(setq ptlst (cons pt1 ptlst))))
   (if (not (equal
         (setq pt1 (vlax-curve-getEndPoint obj)) (car ptlst) 1e-)
     (setq ptlst (cons pt1 ptlst)))
   (reverse ptlst)) ;end
 (defun TraceType1Pline (obj / ptlst objlst lst)
   (setq ptlst (list (vlax-curve-getStartPoint obj))
         objlst (vlax-invoke obj 'Explode))
   (foreach x objlst
     (setq lst (TraceACE x))
     (if (not (equal (car lst) (last ptlst) 1e-)
       (setq lst (reverse lst)))
     (setq ptlst (append ptlst (cdr lst)))
     (vla-delete x))(ZClosed  ptlst)) ;end
 (defun TraceType23Pline (obj / objlst ptlst lastpt)
   (setq objlst (vlax-invoke obj 'Explode)
         lastpt (vlax-get (last objlst) 'EndPoint))
   (foreach x objlst
     (setq ptlst (cons (vlax-get x 'StartPoint) ptlst))
     (vla-delete x))(ZClosed (reverse (cons lastpt ptlst)))) ;end
 (defun Trace3DPline (obj / coord ptlst)
   (setq coord (vlax-get obj 'Coordinates))
   (repeat (/ (length coord) 3)
     (setq ptlst (cons (list (car coord) (cadr coord)(caddr coord)) ptlst))
     (setq coord (cdddr coord)))(ZClosed (reverse ptlst))) ;end
(defun NormalAngle (a)(if (numberp a)(angtof (angtos a 0 14) 0)))
(defun 3d_angw1w2 (Wekt1 Wekt2 / CosA)
(if (equal (setq CosA (/ (apply '+ (mapcar '* Wekt1 Wekt2))
       (distance '(0 0 0) Wekt1) (distance '(0 0 0) Wekt2))) -1.0 1e-6)
 Pi
 (if (equal CosA 0.0 1e-6) (* 0.5 PI)(atan (sqrt (- 1 (* CosA CosA))) CosA))))
 (setq typlst '("AcDb2dPolyline" "AcDbPolyline" "AcDb3dPolyline" "AcDbCircle"
    "AcDbArc" "AcDbEllipse" "AcDbSpline" "AcDbLine"))
 (or (eq (type obj) 'VLA-OBJECT)
   (setq obj (vlax-ename->vla-object obj)))
 (setq typ (vlax-get obj 'ObjectName))
 (if (vl-position typ typlst)
   (cond ((or (eq typ "AcDb2dPolyline") (eq typ "AcDbPolyline"))
     (cond ((or
              (not (vlax-property-available-p obj 'Type))
              (= 0 (vlax-get obj 'Type)))
             (TracePline obj))
           ((or (= 3 (vlax-get obj 'Type)) (= 2 (vlax-get obj 'Type)))
             (TraceType23Pline obj))
           ((= 1 (vlax-get obj 'Type))
             (TraceType1Pline obj))))
      ((eq typ "AcDbLine")(TraceLine obj))
      ((or (eq typ "AcDbCircle") (eq typ "AcDbArc") (eq typ "AcDbEllipse"))
        (TraceACE obj))
      ((eq typ "AcDbSpline")(TraceSpline obj))
      ((eq typ "AcDb3dPolyline")(Trace3DPline obj))
   )))
(defun mip_MakeUniqueMembersOfList  ( lst / OutList head)
 (while lst
   (setq head (car lst)
         OutList (cons head OutList)
         lst (vl-remove-if '(lambda(pt)(equal pt head 1e-6))(cdr lst))
         )
   )
 (reverse OutList)
 )
 (vl-load-com)
 (setq en (car(entsel "\nSelect contour: ")))
 (if (and en (wcmatch (cdr(assoc 0 (entget en))) "*POLYLINE,SPLINE,CIRCLE,ARC,ELLIPSE"))
   (progn
     (setq lst (TraceObject (vlax-ename->vla-object en)))
     (lib:Zoom2Lst lst)
     (setq lst (mapcar '(lambda(x)(trans x 0 1)) lst))
     (setq lst (mapcar '(lambda(x)(list (car x)(cadr x))) lst))
     (setq lst (mip_MakeUniqueMembersOfList lst))
(if (setq ss (ssget opt lst))
 (progn
   (command "_.SELECT" ss "")
   (SSSETFIRST ss ss)
   )
 )

(setq ss nil)))(princ))

[VVA]

OCD - OutSide Contour Delete

(defun C:OCD (  / en ss lst ssall bbox tmp head)
;_Required Express tools
;_OutSide Contour Delete
(vl-load-com)
 (if (null ACET-GEOM-OBJECT-POINT-LIST)
   (progn
     (alert "Required Express tools!!!")
     (exit)
     )
   )
 (if (and (setq en (car(entsel "\nSelect contour: ")))
          (wcmatch (cdr(assoc 0 (entget en))) "*POLYLINE,CIRCLE,ELLIPSE,SPLINE"))
   (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-6))
     (while lst
       (setq head (car lst)
         tmp (cons head tmp)
         lst (vl-remove-if '(lambda(pt)(equal pt head 1e-3))(cdr lst))
         )
       )
     (setq lst (reverse tmp))
     (ACET-SS-ZOOM-EXTENTS (ACET-LIST-TO-SS (list en)))
     (command "_.Zoom" "0.95x")
     (if (and
           (setq ss (ssget "_CP" lst))
           (setq ssall (ssget "_X" (list (assoc 410 (entget en)))))
          )
       (progn
         (setq tmp '-1)
         (repeat (sslength ss)
           (ssdel (ssname ss (setq tmp (1+ tmp))) ssall)
           )
        ;;; (ACET-SS-ENTDEL ssall)
  (command "_.ERASE" ssall "")
         )
       )
     )
   )
)

[Jozi68]

Does anyone have something in .Net?

[fixo]

Does anyone have something in .Net?

 

This will get you started:

 

http://through-the-interface.typepad.com/through_the_interface/2008/02/robotic-hatchin.html

 

To get intersection points between two entities

you can also use this method:

CurveCurveIntersector3d ci = new CurveCurveIntersector3d((Curve3d)myEntity1 as Curve3d, (Curve3d)myEntity2 as Curve3d, new Vector3d(0, 0, 1));//<- change on current ucs plane normal
           for (int i =0;i< ci.NumberOfIntersectionPoints;i++)
           {
Point3d ipt = ci.GetIntersectionPoint(i);
           ed.WriteMessage("\n{0}", ipt);
           }

 

~'J'~

[CALCAD]

nothingspecial,

I think I may know what the problem is, but I can't work on it today. I'll try to respond within 24 hours.

[CALCAD]

nothingspecial,

Try this one.

 

; sdop2.lsp - Select and Delete objects Outside of closed Polyline.
;            To trim objects projecting from closed region, first use
;            TIO, then run SDOP.
; 10-26-09  Rewritten to be generally compatible with Autocad and clones 

(defun findver (entname / verlst lst i)
(setq verlst nil)
(setq i 0)
(setq lst (entget entname))
(repeat (length lst)
(if (= (car (nth i lst)) 10)
 (setq verlst (append verlst (list (cdr (nth i lst)))))
)
(setq i (1+ i))
)
verlst
)

(defun c:sdop (/ *ERROR* lwp fulset flen vset wpset wplen n cname)

(defun *ERROR* (msg)
 (setvar "CMDECHO" 1)
 (setq fulset nil)
 (setq wpset nil)
 (princ)
)

(setvar "CMDECHO" 0)
(setq lwp (car (entsel "\n Pick polyline")))
(setq vset (findver lwp))
(redraw lwp 3)
(setq fulset (ssget "X"))
(setq flen (sslength fulset))
(command "SELECT" "WP" vset "" "")
(setq wpset (ssget "P"))
(ssadd lwp wpset)
(setq wplen (sslength wpset))
(setq n 0)
(repeat flen
(setq cname (ssname fulset n))
(entdel cname)
(setq n (+ 1 n))
)
(setq n 0)
(repeat wplen
(setq cname (ssname wpset n))
(entdel cname)
(setq n (+ 1 n))
)
(setq fulset nil)
(setq wpset nil)
(setvar "CMDECHO" 1)
(redraw)
(princ)
)

[fixo]

Does anyone have something in .Net?

Jozi,

This one has been mostly borrowed from one chinese site

and it's a bit tweaky

You can use it as a sketch

 

using System;
using System.Collections.Generic;
using System.Text;
using Autodesk.AutoCAD.ApplicationServices;
using Autodesk.AutoCAD.Runtime;
using System.Collections;
using Autodesk.AutoCAD.Geometry;
using Autodesk.AutoCAD.DatabaseServices;
using Autodesk.AutoCAD.EditorInput;


namespace Join
{
   public class CurveCommands
   {
       [CommandMethod("bins")]
       public static void Try()
       {
           Editor ed = Application.DocumentManager.MdiActiveDocument.Editor;

           Database db = ed.Document.Database;

           TypedValue[] ftype = { new TypedValue(0, "LWPOLYLINE") };

           PromptSelectionOptions ppo = new PromptSelectionOptions();

           ppo.MessageForRemoval = "\nSelected must be polyline only: ";

           ppo.MessageForAdding = "\nSelect a contour: ";

           SelectionFilter filter = new SelectionFilter(ftype);

           PromptSelectionResult res = ed.GetSelection(ppo, filter);

           if (res.Status != PromptStatus.OK) return;

           using (Transaction tr = db.TransactionManager.StartTransaction())
           {
               foreach (ObjectId id in res.Value.GetObjectIds())
               {
                   Entity ent = (Entity)tr.GetObject(id, OpenMode.ForRead);

                   Curve bcurv = (Curve)ent;

                   TypedValue[] ftype2 = { new TypedValue(0, "*LINE,ARC,CIRCLE,ELLIPSE") };

                   SelectionFilter filter2 = new SelectionFilter(ftype2);

                   PromptSelectionResult pres = ed.SelectAll(filter2);

                   DBObjectCollection objs = new DBObjectCollection();

                   ObjectId[] ents = pres.Value.GetObjectIds();

                   foreach (ObjectId nid in ents)
                   {
                       List<Point3d> ptlist = new List<Point3d>();

                       List<double> dslist = new List<double>();

                       if (nid != id)
                       {
                           Curve scurv = (Curve)tr.GetObject(nid, OpenMode.ForWrite);

                           Point3dCollection pts = new Point3dCollection();

                           scurv.IntersectWith(bcurv, Intersect.OnBothOperands, pts, 0, 0);

                           foreach (Point3d p in pts)
                           {
                               ptlist.Add(p);

                               dslist.Add(scurv.GetDistAtPoint(p));
                           }
                           if (ptlist.Count > 0)
                           {
                               Point3d[] ptarr = ptlist.ToArray();

                               Array.Sort(dslist.ToArray(), ptarr);

                               try
                               {
                                   objs = scurv.GetSplitCurves(new Point3dCollection(ptarr));

                                   BlockTableRecord btr = (BlockTableRecord)tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite);

                                   DBObjectCollection ercol = new DBObjectCollection();

                                   foreach (Curve curv in objs)
                                   {

                                       btr.AppendEntity(curv);

                                       tr.AddNewlyCreatedDBObject(curv, true);

                                       Point3d npt = nearestpoint(curv);

                                       if ((Fns.IsInsideCurve(bcurv, npt)) && (id != curv.ObjectId))
                                           ercol.Add(curv);//Class Fns is here:http://through-the-interface.typepad.com/through_the_interface/2008/02/robotic-hatchin.html

                                   }
                                   foreach (DBObject eobj in ercol)
                                   {
                                       eobj.UpgradeOpen();
                                       eobj.Erase();
                                       eobj.Dispose();
                                   }
                                   foreach (ObjectId idx in ents)
                                   {
                                       if (id != idx)
                                       {
                                           Entity dent = (Entity)tr.GetObject(idx, OpenMode.ForRead);
                                           dent.UpgradeOpen();
                                           dent.Erase();
                                           dent.Dispose();
                                       }
                                   }
                               }
                               catch (Autodesk.AutoCAD.Runtime.Exception ex)
                               {
                                   ed.WriteMessage("\n{0}", ex.Message);
                               }
                           }
                       }

                   }
               }
               tr.Commit();
           }
       }
       public static Point3d nearestpoint(Curve curv)
       {
           return curv.GetPointAtDist(0.001);
       }

 

~'J'~