Jump to content

Intersection points

SELFCAD

By SELFCAD
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

SELFCAD Explorer

SELFCAD

Posted
Posted

I have...20 lines, i want to make a list with all intersection points of this lines...no duplicates...how?

fixo Mentor

fixo

Posted
Posted

Give this a try

 
(defun C:PTS(/ *error* adoc elist en ent ep ip osm p1 p2 points sp sset)
(defun *error* (msg)
(vla-endundomark (vla-get-activedocument
(vlax-get-acad-object))
)
(cond ((or (not msg)
(member msg '("console break" "Function cancelled" "quit / exit abort"))
)
)
((princ (strcat "\nError: " msg)))
)
(setvar "cmdecho" 1)
(if osm
(setvar "osmode" osm)
)

(princ)
)
(setq adoc (vla-get-activedocument
(vlax-get-acad-object)))
(vla-startundomark adoc )

(setq osm (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 512)
(setq p1 (getpoint "\nPick a first point of fence selection: ")
p2 (getpoint p1"\nPick a first point of fence selection: "))

(if (setq sset (ssget "F" (list p1 p2) (list (cons 0 "line"))))

(progn
(while (setq en ( ssname sset 0))
(setq elist (entget en)
sp (cdr (assoc 10 elist))
ep (cdr (assoc 11 elist))
ip (inters sp ep p1 p2 nil))
(setq points (cons ip points))
(ssdel en sset)
)
(setq points (vl-sort points '(lambda(a b)(< (distance p1 a)(distance p1 b)))))
(foreach pt points
(command "_.circle" pt 10.0))
)
)
(*error* nil)

(princ)
)
(princ "\n\t---\tStart command with: \"PTS\"\t---")
(princ)
(or (vl-load-com)(princ))

SELFCAD Explorer

SELFCAD

Posted
  • Author
Posted

If you can make it for polylines too, is ok...

fixo Mentor

fixo

Posted
Posted
If you can make it for polylines too, is ok...

You wrote:

I have...20
lines
, i want to make a list with all intersection points of this
lines
...no duplicates...how?

So it's just my answer on this question

pBe Grand Master

pBe

Posted
Posted

I wrote something like this before. to work for both lines and polylines.

I'll post it when i find it :)

Stefan BMR Proficient

Stefan BMR

Posted
Posted (edited) 
(vl-load-com)
(defun C:TEST ( / ss lst en l)
 (if
   (setq ss (ssget '((0 . "LINE,*POLYLINE"))))
   (progn
     (repeat (sslength ss)
       (setq lst (cons (vlax-ename->vla-object (setq en (ssname ss 0))) lst))
       (ssdel en ss)
     )
     (while (cdr lst)
       (foreach e (cdr lst)
         (foreach int (l2p (vlax-invoke (car lst) 'IntersectWith e acExtendNone))
           (if (not (vl-some (function (lambda (x) (equal (distance int x) 0.0 1e-)) l))
             (setq l (cons int l))
           )
         )
       )
       (setq lst (cdr lst))
       )
     )
   )
 (if l (foreach n l (entmake (list '(0 . "POINT") (cons 10 n)))))
 (princ)
 )

(defun l2p (l)
 (if l
   (cons (list (car l) (cadr l) (caddr l)) (l2p (cdddr l)))
   )
 )

Doesn't show points on self-intersecting Polylines.

Edited by Stefan BMR
Fixed
SELFCAD Explorer

SELFCAD

Posted
  • Author
Posted

I made something like this, for lines only... some help to complete and debug, please...

(defun c:inter
 ()
 (setq ss (ssget '((0 . "LINE"))))
 (setq i 0)
 (setq lista nil)
 (repeat (sslength ss)
   (setq ename (ssname ss i))
   (setq data (entget ename))
   (setq entName (cdr (assoc -1 data)))
   (setq pstart (cdr (assoc 10 data)))
   (setq pend (cdr (assoc 11 data)))
   (setq lista (cons (list entName pstart pend) lista))
   (setq i (1+ i))
 ) ;_ end of repeat
 (setq lista (reverse lista))

(setq pintlist nil)
 
(foreach n lista
 (setq e (car n)
   ps (cadr n)
   pe (caddr n)
   listar (append (setq lista1 (member n lista)) 
              (setq lista2 (cddr(member n (reverse lista))))))

   (foreach m listar
     (setq er (car m)
       psr (cadr m)
       per (caddr m)
           pint (inters ps pe psr  per)    
       pintlist (cons pint pintlist))
 )
)
) ;_ end of defun

pBe Grand Master

pBe

Posted
Posted (edited)

I found an old code. but its somewhat simlar to to how the Stefans code is written.

I like this:

 (defun l2p (l)
 (if l
   (cons (list (car l) (cadr l) (caddr l)) (l2p (cdddr l)))
   )
 )

 

kudos Stefan :thumbsup:

 

I'll take a look at your code later SELFCAD

 

In case you're interested: [modified to show point entity]

(defun  _Interspbe  (ss / en pts ss en pts)
(vl-load-com)      
(repeat (sslength ss)
     (setq en (cons (vlax-ename->vla-object (ssname ss 0)) en))
     (ssdel (ssname ss 0) ss)
     )
     (while en
           (setq pt (car en))
          (mapcar '(lambda (p l / l pt_)
                         (while l
                                (if (setq v (vlax-invoke  p 'IntersectWith
                       (car l)  acExtendNone))
                                    (repeat (/ (length v) 3)
                                       (setq pt_ (list (car v)(cadr v)(caddr v))
                                             v (member (nth 3 v) v))
    (if (and pt_ (not (vl-position  pt_ pts)))
                                       (setq pts (cons pt_ pts))))
                                    )
                                     (setq l (cdr l)))
  )       
                 (list pT) (list (setq en (vl-remove pt en)))
           )
)
;;;   to show the points      ;;;
     (if pts (foreach n pts (entmake (list '(0 . "POINT") (cons 10 n)))))
;;;   to show the points      ;;;
     pts ;;;<--- as orignally written
       )

Edited by pBe
SELFCAD Explorer

SELFCAD

Posted
  • Author
Posted

Finally, i made something... but only for lines... Thanks, Stefan!

 

(defun c:inter
 ()
;;;;;;;;;;;;;;;;;;;;;;;;;
(DEFUN remdup (lst)
 (IF lst
   (CONS (CAR lst) (remdup (VL-REMOVE (CAR lst) lst)))
 ) ;_ end of IF
) ;_ end of DEFUN
;;;;;;;;;;;;;;;;;;;;;;;;
 
 (setq ss (ssget '((0 . "LINE"))))
 (setq i 0)
 (setq lista nil)
 (repeat (sslength ss)
   (setq ename (ssname ss i))
   (setq data (entget ename))
   (setq entName (cdr (assoc -1 data)))
   (setq pstart (cdr (assoc 10 data)))
   (setq pend (cdr (assoc 11 data)))
   (setq lista (cons (list entName pstart pend) lista))
   (setq i (1+ i))
 ) ;_ end of repeat
 (setq lista (reverse lista))

(setq pintlist nil)
 
(foreach n lista
 (setq e (car n)
   ps (cadr n)
   pe (caddr n)
   listar (append (setq lista1 (member n lista)) 
              (setq lista2 (cddr(member n (reverse lista))))))

   (foreach m listar
     (setq er (car m)
       psr (cadr m)
       per (caddr m)
           pint (inters ps pe psr  per)    
       pintlist (cons pint pintlist))
 )
)
(setq pintlist (remdup pintlist))
(setq pintlist (VL-REMOVE nil pintlist))
 (foreach p pintlist
   (command "circle" p 0.3)
   )
) ;_ end of defun

pBe Grand Master

pBe

Posted
Posted

This mod will be enough on your ogrinal code SELFCAD

 

 
(foreach m listar
     (setq er (car m)
       psr (cadr m)
       per (caddr m)
           pint (inters ps pe psr  per)[color=blue][b])[/b][/color]
[b][color=blue](if (and pint
               (not (vl-position pint pintlist)))
[/color][/b]             [b][color=blue](setq[/color] [/b]pintlist (cons pint pintlist)))
 )

Tharwat Grand Master

Tharwat

Posted
Posted

Here is my final version ... :)

 

(defun c:TesT (/ ss i sn ents e n p pick pts inc pt)
 (vl-load-com)
;;; Tharwat 08. May. 2012 ;;;
 (if (setq ss (ssget '((0 . "LINE,*POLYLINE"))))
   (progn
     (repeat (setq i (sslength ss))
       (setq sn (ssname ss (setq i (1- i))))
       (setq ents (cons (vlax-ename->vla-object sn) ents))
     )
     (setq e   ents
           n   0
           pts '()
     )
     (foreach obj e
       (foreach x ents
         (if
           (and (not (equal obj x))
                (setq p (vlax-invoke obj 'IntersectWith x acExtendNone))
           )
            (setq pts (append p pts))
         )
       )
     )
   )
 )
 (setq inc -1)
 (repeat (/ (length pts) 3)
   (setq pt (list (nth (setq inc (1+ inc)) pts)
                  (nth (setq inc (1+ inc)) pts)
                  (nth (setq inc (1+ inc)) pts)
            )
   )
   (if (not (ssget "_c" pt pt '((0 . "POINT"))))
     (entmakex (list '(0 . "POINT") (cons 10 pt)))
   )
 )
(princ)
 )

David Bethel Grand Master

David Bethel

Posted
Posted

Here's a old 1 for Coplaner 2D Model spaces line only:

 

[b][color=BLACK]([/color][/b]defun c:lineint [b][color=FUCHSIA]([/color][/b]/ ss cs i c en ed p10 p11 cn cd c10 c11 in pl[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]and [b][color=NAVY]([/color][/b]setq ss [b][color=MAROON]([/color][/b]ssget '[b][color=GREEN]([/color][/b][b][color=BLUE]([/color][/b]0 . [color=#2f4f4f]"LINE"[/color][b][color=BLUE])[/color][/b][b][color=BLUE]([/color][/b]67 . 0[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]setq cs [b][color=MAROON]([/color][/b]eval ss[b][color=MAROON])[/color][/b]
             i 0[b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]while [b][color=MAROON]([/color][/b]setq en [b][color=GREEN]([/color][/b]ssname ss i[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]setq c 0
                   i [b][color=GREEN]([/color][/b]1+ i[b][color=GREEN])[/color][/b]
                  ed [b][color=GREEN]([/color][/b]entget en[b][color=GREEN])[/color][/b]
                 p10 [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc 10 ed[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                 p11 [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc 11 ed[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]while [b][color=GREEN]([/color][/b]setq cn [b][color=BLUE]([/color][/b]ssname cs c[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                    [b][color=GREEN]([/color][/b]and [b][color=BLUE]([/color][/b]setq c [b][color=RED]([/color][/b]1+ c[b][color=RED])[/color][/b]
                              cd [b][color=RED]([/color][/b]entget cn[b][color=RED])[/color][/b]
                             c10 [b][color=RED]([/color][/b]cdr [b][color=PURPLE]([/color][/b]assoc 10 cd[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b]
                             c11 [b][color=RED]([/color][/b]cdr [b][color=PURPLE]([/color][/b]assoc 11 cd[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                         [b][color=BLUE]([/color][/b]not [b][color=RED]([/color][/b]eq en cn[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                         [b][color=BLUE]([/color][/b]setq in [b][color=RED]([/color][/b]inters p10 p11 c10 c11[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                         [b][color=BLUE]([/color][/b]not [b][color=RED]([/color][/b]member in pl[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                         [b][color=BLUE]([/color][/b]setq pl [b][color=RED]([/color][/b]cons in pl[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]prin1 [b][color=NAVY]([/color][/b]length pl[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

 

-David

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...