Jump to content

Recommended Posts

Posted (edited)

I 'm looking for a simple lisp that can place points at both end of selected lines and at the intersection

 

Please help !

 

thank you 

lucky9

 

 

Edited by lucky9
Posted

Hello, sorry for the large format but dont have time to create more clear lisp. :)

(defun c:try1 ( / sel sel1 intList)

(setq sel (ssget (list (cons 0 "Line"))))
(setq sel1 (VaniVL sel "Trudy"))

(if sel
    (setq intList (LM:intersectionsinset sel))
)
(vlax-for x sel1
	(setq intList (append intList (list (vlax-get x 'EndPoint) (vlax-get x'StartPoint))))
)
(setq intList (T:filer intList))
(mapcar '(lambda (x) (entmake (list '(0 . "POINT") (cons 10 x)))) intList)	
(princ)
)


(defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
)

(defun LM:intersectionsinset ( sel / id1 id2 ob1 ob2 rtn )
    (repeat (setq id1 (sslength sel))
        (setq ob1 (vlax-ename->vla-object (ssname sel (setq id1 (1- id1)))))
        (repeat (setq id2 id1)
            (setq ob2 (vlax-ename->vla-object (ssname sel (setq id2 (1- id2))))
                  rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn)
            )
        )
    )
    (apply 'append (reverse rtn))
)

(defun VaniVL ( SS SSnm / i L SScoll SfArrayObjs vSS )
  (cond
    ( (not (eq 'PICKSET (type SS))) nil)
    ( (not (and (eq 'STR (type SSnm)) (snvalid SSnm))) nil)
    (T
      (repeat (setq i (sslength SS))
        (setq L (cons (vlax-ename->vla-object (ssname SS (setq i (1- i)))) L))
      )
      (setq SScoll (vla-get-SelectionSets (vla-get-ActiveDocument (vlax-get-acad-object))))
      (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-Item (list SScoll SSnm))))
        (vla-Delete (vla-Item SScoll SSnm))
      )
      (setq vSS (vla-Add SScoll SSnm))
      (setq SfArrayObjs (vlax-make-safearray vlax-vbObject (cons 0 (1- (length L)))))
      (setq i -1)
      (foreach o L (vlax-safearray-put-element SfArrayObjs (setq i (1+ i)) o) )
      (vla-AddItems vSS SfArrayObjs)
      vSS
    )
  ); cond
); defun VanillaSS->VlaSS


(defun T:filer (allcord / SinPoint)
;Delete dubllated things in list
	(while allcord
		(setq SinPoint (cons (car allcord) SinPoint))
		(setq allcord (vl-remove (car allcord) allcord))
	)
	SinPoint
)

 

  • Like 2
Posted

Simple enough to put points at the ends. But Intersections no idea.

 

(defun C:PTZ (/ SS lst)
  (if (setq SS (ssget '((0 . "LINE"))))
    (progn
      (foreach line (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
        (setq lst (cons (cdr (assoc 10 (entget line))) lst)
              lst (cons (cdr (assoc 11 (entget line))) lst)
        )
      )
      (foreach PT lst
        (entmake (list (cons 0 "POINT")
                       (cons 10 PT)
                 )
        )
      )
    )
  )
  (princ)
)

 

  • Like 1
Posted

Thank you so much guys, 

@Trudy Thank you so much, it was my mistake mentioning that the line I was asking for 3D Polyline  instead of simple line. can it be modified to also include 3dpolylines..

 

My bad sorry for that. 

Posted
1 hour ago, mhupp said:

Simple enough to put points at the ends. But Intersections no idea.

 

For your info..... Lee Macs intersectionsinset Trudy has copied into the code above, should do that

Posted
2 hours ago, Steven P said:

 

For your info..... Lee Macs intersectionsinset Trudy has copied into the code above, should do that

 

I see that and just append the lst for the endpoints. I think we posted with in mins of each other.

 

Its cool to see these do the same thing.

(mapcar '(lambda (x) (entmake (list '(0 . "POINT") (cons 10 x)))) intList)	

(foreach PT lst
   (entmake (list (cons 0 "POINT")
                  (cons 10 PT)
   )
 )
)

 

Also how they get the endpoints is better.

  • Like 2
Posted

Guys, need modification to work with 3d polylines.. 🙏

Posted
2 hours ago, lucky9 said:

Guys, need modification to work with 3d polylines.. 🙏

 

update @Trudy's code. Added so Arcs and Polylines can be selected. had to replace (vlax-get x 'EndPoint) with (vlax-curve-getEndPoint x) would error on polylines.

Also I don't know if their will be an intersection point if 2 3d polylines cross but they are at different elevations.

(defun c:try1 (/ sel sel1 intList typ)
  (setq sel (ssget '((0 . "ARC,LINE,*POLYLINE"))))
  (setq sel1 (VaniVL sel "Trudy"))
  (if sel
    (setq intList (LM:intersectionsinset sel))
  )
  (vlax-for x sel1
    (setq intList (append intList (list (vlax-curve-getStartPoint x) (vlax-curve-getEndPoint x))))
  )
  (setq intList (T:filer intList))
  (mapcar '(lambda (x) (entmake (list '(0 . "POINT") (cons 10 x)))) intList)
  (princ)
)

 

  • Like 1
Posted
7 hours ago, mhupp said:

 

update @Trudy's code. Added so Arcs and Polylines can be selected. had to replace (vlax-get x 'EndPoint) with (vlax-curve-getEndPoint x) would error on polylines.

Also I don't know if their will be an intersection point if 2 3d polylines cross but they are at different elevations.


(defun c:try1 (/ sel sel1 intList typ)
  (setq sel (ssget '((0 . "ARC,LINE,*POLYLINE"))))
  (setq sel1 (VaniVL sel "Trudy"))
  (if sel
    (setq intList (LM:intersectionsinset sel))
  )
  (vlax-for x sel1
    (setq intList (append intList (list (vlax-curve-getStartPoint x) (vlax-curve-getEndPoint x))))
  )
  (setq intList (T:filer intList))
  (mapcar '(lambda (x) (entmake (list '(0 . "POINT") (cons 10 x)))) intList)
  (princ)
)

 

 

 

I'm getting this error : 

 

; error: no function definition: VANIVL

 

 thanks 

 

Posted
3 hours ago, lucky9 said:

 

 

I'm getting this error : 

 

; error: no function definition: VANIVL

 

 thanks 

 

 

Because that's only the first part of the  code. You have to load the rest of trudy's code.

Posted
3 hours ago, mhupp said:

 

Because that's only the first part of the  code. You have to load the rest of trudy's code.

 

It's alright to copy other's code into yours, as long as you reference that it's theirs and not yours. It's the typical with copying Lee's subfunctions too. ;)

  • Confused 1
Posted

It's not my code. I edit trudy's code to work with polylines like lucky was asking for. Since its better code then mine. If you update the try1 function with what I posted then it should do what lucky wants. still don't know if it will create points if 2 3d polylines cross in the xy but not z.

Posted

mhupp looks like no for 3d lines crossing, the only idea I have is work out in 2d the xy of the intersection point then can work out the 3d pt for the two 3d lines.

  • Thanks 1

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.

×
×
  • Create New...