LISP that selects all overlaping lines

[CADSURAY]

58 minutes ago, GLAVCVS said:

 

@CADSURAY

But no.
I've taken a look at your code and I see things that are not right.
You apply a single filter for lines, polylines and arcs:
the match in codes 10 and 11.
But that match can only occur in lines, because neither polylines nor arcs use code 11.

Your code works 'apparently' when it is true that code 10 matches between 2 objects. And code 11, in any entity that is not a line, will always match, because it will always be 'nil'. That is, code 11 of a polyline, an arc, a 'leader', a 'hatch'... etc. will always match.
As for code 10, in arc objects it will always match when the center is the same, even if they do not overlap.
In polylines, it will also match when only the first point of the polyline matches, even if no other points match.

Conclusion: your code only works well with LINE objects.

i see you point GLAVCVS 

finding the short overalapping part of the whole longer line is easy to find only the short part alone..

what do we need to do with long part upto the overlapping length? cut it into two pices and delete / select the overlapping part?

 

[Danielm103]

I’m sure there’s a cascade of checks that should take place after its determined that two objects may overlap. One of which may be to divide the curve into params, then get the point at each param and check if the point is on the other curve.

[Danielm103]

3 minutes ago, CADSURAY said:

***cut it into two pices and delete / select the overlapping part?

 

There’s a function for this in ARX, AcDbCurve::getSplitCurves. Once you have the overlap intervals, you can dice and splice.  

[CADSURAY]

28 minutes ago, Steven P said:

CadSuray, the above are constructive comments by the way, not criticism (I know you won't take them as such... but some internet forums are full of prima-donnas, this one isn't).

 

Take them as the forum are quite happy to help you out with this one, this could turn out to be a useful LISP for many.

Not at all Steven P..

 

I know how Help full CADTutot Has been to me..

I Really Appreciate the All the Great Contributors in this forum..

 

i was a member previously 

suryacad joined in 2016.. just joined back with a new id as is lost the old one...

 

i appreciate every piece of advice on this forum.. i took my baby steps to lisp here and seeked a lot of help on this forum previously..

[Steven P]

Just for reference, a quick change to my code above to delete both duplicated line, arc, circles, applying a 'fuzz' factor for the comparisons

 

(defun c:test ( / MySS acount acounter DelSS MyLine NextLine MyEndA MyEndB NextEndA NextEndB)
  (setq fuzz 0.01)
  (setq MySS (ssget '((0 . "LINE,ARC,CIRCLE")))) ;; Select all lines
  (setq DelSS (ssadd))                ;; Blank selection set
  (setq acount 0)                     ;; A counter
  (while (< (+ acount 1) (sslength MySS)) ;; A loop the length of selection less 1
    (setq MyLine (ssname MySS acount)) ;; Line to assess (works through full selection set)
    (setq MyEndA (cdr (assoc 10 (entget MyLine)))) ;; Assessed line end points
    (setq MyEndB (cdr (assoc 11 (entget MyLine))))
    (setq acounter (+ acount 1))
    (while (< acounter (sslength MySS))  ;; Compare rest of selecton set
      (setq NextLine (ssname MySS acounter)) ;; A line to compare with
      (setq NextEndA (cdr (assoc 10 (entget NextLine)))) ;; Comparison line end points
      (setq NextEndB (cdr (assoc 11 (entget NextLine))))

      (if (and ;; If lines line up
          (or
            (equal MyEndA NextEndA fuzz)
            (equal MyEndA NextEndB fuzz)
          ) ; endor
          (or
            (equal MyEndB NextEndA fuzz)
            (equal MyEndB NextEndB fuzz)
          ) ; endor
          (equal (assoc 40 (entget MyLine)) (assoc 40 (entget NextLine)) fuzz)
          (equal (assoc 50 (entget MyLine)) (assoc 50 (entget NextLine)) fuzz)
          (equal (assoc 51 (entget MyLine)) (assoc 51 (entget NextLine)) fuzz)
        ) ; end And
        (progn
          (setq DelSS (ssadd MyLine DelSS)) ;; Add MyLine to deletion selection set
          (setq DelSS (ssadd NextLine DelSS)) ;; Add next line to deletion selection set. Ignore one to only delete 1 line
        ) ; end progn
        (progn ;; if lines don't line up... do nothing
        ) ; end progn
      ) ; end if

      (setq acounter (+ acounter 1))
    ) ; end while acounter
    (setq acount (+ acount 1))
  ) ; end while acount

  (command "erase" DelSS "")
  (princ)
)

 

 

 

Text, mtexts will need to get bounding box to acount for different justifications of the same text in same location

[Steven P]

And this one kind of does polylines, leaving it here as is for now - weekend! CAD is going off

 

If you want to do some homework this will do 2 polylines as it is just now, need to add in the 2nd looping (see my code above). Sill a bit long winded of course, coffee while it runs on a large drawing but kind of works.

 

Note added inside the code where to add the 'doing stuff' when you get to identical polylines (with a fuzz factor added)

 

Fuzz factors: Maybe look at setting these according to the polyline length, say 0.5% or something like that

 

 

(defun c:test ( / fuzz MySS acount MyLine MyEndA MyEndB MyLinePoints MyLineBulges Nextline NextEndA NExtEndB NextLinePoints)
;;Sub functions
  (defun mAssoc ( key lst / result )
    (foreach x lst
      (if (= key (car x)) (setq result (cons (cdr x) result)) )
    )
    (reverse result)
  )

  (setq fuzz 0.01) ; fuzz factor
  (setq MySS (ssget '((0 . "LWPOLYLINE"))))
  (setq acount 0)
  (while (< (+ acount 1) (sslength MySS))
    (Setq MyLine (ssname MySS acount))
    (setq MyEndA (cdr (assoc 10 (entget MyLine))))
    (setq MyEndB (cdr (assoc 10 (reverse (entget MyLine)))))
    (setq MyLinePoints (massoc 10 (entget MyLine)))
    (setq MyLineBulges (massoc 42 (entget MyLine)))


;; Start 2nd loop here from acount + 1 onwards as starter for NextLine count

    (setq NextLine (ssname MySS (+ acount 1)))
    (setq NextEndA (cdr (assoc 10 (entget NextLine))))
    (setq NextEndB (cdr (assoc 10 (reverse (entget NextLine)))))

    (if (and
        (or (equal MyEndA NextEndA 0.01)(equal MyEndA NextEndB Fuzz) ) ; endor
        (or (equal MyEndB NextEndA 0.01)(equal MyEndB NextEndB Fuzz) ) ; endor
      ); End And - Ends A & B Match
      (progn                         ; Ends A & B Match. Error if closed polyline with different start points
        (setq NextLinePoints (massoc 10 (entget NextLine)))
        (if (= (length NextLinePoints) (length MyLinePoints))
          (progn
           (setq MyPtListLen (length MyLinePoints))
            (setq MatchingPoints 0)
            (foreach pt MyLinePoints
              (if (vl-member-if '(lambda (x) (equal x pt Fuzz)) NextLinePoints)
                (progn
                  (setq MatchingPoints (+ MatchingPoints 1))
                )                    ; end progn matching points
              )                      ; end if member nextlinepoints
            )                        ; end foreach pt linepoints
            (if (= MatchingPoints MyPtListLen)
              (progn
                (setq NextLineBulges (massoc 42 (entget NextLine)))
                (setq MatchingBulges 0)
                (foreach bulge MyLineBulges
                  (if (vl-member-if '(lambda (x) (equal x bulge Fuzz)) NextLineBulges)
                    (progn
                      (setq MatchingBulges (+ MatchingBulges 1))
                    ) ; end progn matching points
                  ) ; end if
                ) ; end foreach
                (if (= MatchingPoints MyPtListLen)
                  (progn


                    (princ "All Bulges match")
;; Polyline matches points and bulges within tolerances
;; Do your stuff here


                  ) ; end progn
                )
              )
            )
          ) ; end progn - no of points
        ) ; end if
      ) ; end progn, Ends match
    ) ; End IF

;;End 2nd loop here

    (setq acount (+ acount 1))
  )
  (princ)
)

 

 

No comments added yet either. Kind of similar to what I had above.

 

 

To speed these up use ssget CP (I think) for each entity in the first loop reduces the number of entities considered each loop. Get the basics working right first though.

Edited 10 hours ago by Steven P