Jump to content

Create point at the end of lines


lucky9

Recommended Posts

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
Link to comment
Share on other sites

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
Link to comment
Share on other sites

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
Link to comment
Share on other sites

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. 

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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
Link to comment
Share on other sites

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
Link to comment
Share on other sites

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 

 

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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
Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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...