Jump to content

I am looking for a autolisp routine to add a point at both ends of each line and each polyline in a drawing.

Ashishs

By Ashishs
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Emmanuel Delay Proficient

Emmanuel Delay

Posted
Posted (edited)

Command PELP (abbreviation of your title (kind of))  

(vl-load-com)

;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/
(defun drawPoint (pt)
 (entmakex (list (cons 0 "POINT")
                 (cons 10 pt))))
                 
(defun c:pelp ( / ss i pt ent)
    (setq ss (ssget (list (cons 0 "LINE,POLYLINE,LWPOLYLINE"))))
    (setq i 0)
    (repeat (sslength ss)
        (setq ent (ssname ss i))
        ;; start point
        (setq pt (vlax-curve-getStartPoint (vlax-ename->vla-object ent)))
        (drawPoint pt)
        ;; end point
        (setq pt (vlax-curve-getEndPoint (vlax-ename->vla-object ent)))
        (drawPoint pt)
        (setq i (+ i 1))
    )
)

 

Edited by Emmanuel Delay
  • Like 2
Link to comment
Share on other sites
Ashishs Contributor

Ashishs

Posted
  • Author
Posted
29 minutes ago, Emmanuel Delay said:

Command PELP (abbreviation of your title)  

(vl-load-com)

;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/
(defun drawPoint (pt)
 (entmakex (list (cons 0 "POINT")
                 (cons 10 pt))))
                 
(defun c:pelp ( / ss i pt ent)
    (setq ss (ssget (list (cons 0 "LINE,POLYLINE,LWPOLYLINE"))))
    (setq i 0)
    (repeat (sslength ss)
        (setq ent (ssname ss i))
        ;; start point
        (setq pt (vlax-curve-getStartPoint (vlax-ename->vla-object ent)))
        (drawPoint pt)
        ;; end point
        (setq pt (vlax-curve-getEndPoint (vlax-ename->vla-object ent)))
        (drawPoint pt)
        (setq i (+ i 1))
    )
)

 

This helps:) Thanks a ton.

Link to comment
Share on other sites
Ashishs Contributor

Ashishs

Posted
  • Author
Posted
6 minutes ago, Ashishs said:

This helps:) Thanks a ton.

Still one issue...lines which are connected end to end gets 2 points added at common node. Is it possible to get only one point at the common node of the lines connected end to end.

Link to comment
Share on other sites
Emmanuel Delay Proficient

Emmanuel Delay

Posted
Posted

Okay,

I draw all the points, then at the end I search for doubles.  2 points ta the same place, each belonging to another line.

And I delete them both.

  

(vl-load-com)

;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/
(defun drawPoint (pt)
 (entmakex (list (cons 0 "POINT")
                 (cons 10 pt))))

(defun very_close_together ( p1 p2 / )
  (if 
	(< (distance p1 p2) 0.000001)
	T
	nil
  )
)
				 
(defun delete_doubles ( points pts / i j p1 p2)

	(setq i 0)
	(repeat (length pts)
		(setq p1 (nth i pts))
		(setq j (+ i 1))
		(princ "\n")
		(while (nth j pts)
			(setq p2 (nth j pts))
			;; now check if p1 and p2 are the same point.  If so, then delete both
	
			(if (very_close_together  p1 p2 )
				(progn
					(entdel (nth i points ))
					(entdel (nth j points ))
				)
			)
			(setq j (+ j 1))
		)
		(setq i (+ i 1))
	)
)
				 
(defun c:pelp ( / ss i pt ent points pts)
	(setq ss (ssget (list (cons 0 "LINE,POLYLINE,LWPOLYLINE"))))
	(setq i 0)
	(setq points (list))
	(setq pts (list))
	(repeat (sslength ss)
		(setq ent (ssname ss i))
		;; start point
		(setq pt (vlax-curve-getStartPoint (vlax-ename->vla-object ent)))
		(setq pts (append pts (list  pt)))
		(setq points (append points (list (drawPoint pt))))
		;; end point
		(setq pt (vlax-curve-getEndPoint (vlax-ename->vla-object ent)))
		(setq pts (append pts (list  pt)))
		(setq points (append points (list (drawPoint pt))))
		(setq i (+ i 1))
	)
	(delete_doubles  points pts)
	(princ )
)

 

Link to comment
Share on other sites
Ashishs Contributor

Ashishs

Posted
  • Author
Posted
3 minutes ago, Emmanuel Delay said:

Okay,

I draw all the points, then at the end I search for doubles.  2 points ta the same place, each belonging to another line.

And I delete them both.

  

(vl-load-com)

;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/
(defun drawPoint (pt)
 (entmakex (list (cons 0 "POINT")
                 (cons 10 pt))))

(defun very_close_together ( p1 p2 / )
  (if 
	(< (distance p1 p2) 0.000001)
	T
	nil
  )
)
				 
(defun delete_doubles ( points pts / i j p1 p2)

	(setq i 0)
	(repeat (length pts)
		(setq p1 (nth i pts))
		(setq j (+ i 1))
		(princ "\n")
		(while (nth j pts)
			(setq p2 (nth j pts))
			;; now check if p1 and p2 are the same point.  If so, then delete both
	
			(if (very_close_together  p1 p2 )
				(progn
					(entdel (nth i points ))
					(entdel (nth j points ))
				)
			)
			(setq j (+ j 1))
		)
		(setq i (+ i 1))
	)
)
				 
(defun c:pelp ( / ss i pt ent points pts)
	(setq ss (ssget (list (cons 0 "LINE,POLYLINE,LWPOLYLINE"))))
	(setq i 0)
	(setq points (list))
	(setq pts (list))
	(repeat (sslength ss)
		(setq ent (ssname ss i))
		;; start point
		(setq pt (vlax-curve-getStartPoint (vlax-ename->vla-object ent)))
		(setq pts (append pts (list  pt)))
		(setq points (append points (list (drawPoint pt))))
		;; end point
		(setq pt (vlax-curve-getEndPoint (vlax-ename->vla-object ent)))
		(setq pts (append pts (list  pt)))
		(setq points (append points (list (drawPoint pt))))
		(setq i (+ i 1))
	)
	(delete_doubles  points pts)
	(princ )
)

 

Thanks...but this deletes both the points. Only one point should be deleted. So all lines and the polylines to have one point at the dead end or one point at the common end.

Link to comment
Share on other sites
mhupp Grand Master

mhupp

Posted
Posted (edited)

Another way just build the list of points. Then sort for unique points then mass create whats left.

  

;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/
(defun drawPoint (pt)
  (entmakex (list '(0 . "POINT")
                   (cons 10 pt)
            )
  )
)
(defun c:pelp ( / ss pt ent pt-lst)
  (setq ss (ssget '((0 . "LINE,POLYLINE,LWPOLYLINE"))))
  (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (setq pt-lst (cons (vlax-curve-getStartPoint (vlax-ename->vla-object ent)) pt-lst))
    (setq pt-lst (cons (vlax-curve-getEndPoint (vlax-ename->vla-object ent)) pt-lst))
  )
  (setq pt-lst (LM:Unique pt-lst))
  (foreach pt pt-lst
    (drawPoint pt)
  )
  (princ)
)
;; Unique  -  Lee Mac
;; Returns a list with duplicate elements removed.
(defun LM:Unique ( l )
    (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l)))))
)

 

 

Edited by mhupp
  • Like 1
Link to comment
Share on other sites
  • 1 year later...
labo Newbie

labo

Posted
Posted

Hi everyone, Emmanuel, your lisp was very useful. I used it to take data from road cross section composed of lines and polylines and then together with other lisps create an external txt with station offset and height of each point in csection, so later i used civil 3d command to draw points from txt file on actual position in plan view, in 3d. Now a great thing would be that the points drawn are the same layer as line or polyline on whos ends this lisp drew points. This way i could create alot of points in each cross section, and by freezing layer by layer could create surfaces of subgrade, asphalt, subsoil etc... is it possible to achieve this without too much work? also, double points in this case are good.

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

Understand what your doing but are you matching the cross sections to a chainage along an alignment ? In particular where an alignment has curves. having played with surfaces for to many years to get a box shape like a subgrade you need the edge points bottom to top to be like 0.00001 outward else the surface model will be incorrect.

 

I think I saw something at www.CivilSiteDesign about exactly this question, you can ask them, it runs in CIV3D and is more friendly to use.

Link to comment
Share on other sites
labo Newbie

labo

Posted
Posted

Hi Bigal, thanks for reply. I know what you mean. A very good observation. Surface is created jumping up and down, never looking like it should. Had that isuue many times when guys survey a tunnel for example, and create one surface from it. It would be issue with any box shape part of the road, here designers draw box shape subgrade below gutter, also asphalt sometimes is drawn as box shape. It could be done in lisp to check all points that are on same chainage, same layer, if offset is the same, and then if it is, depending if it is left or right from alignment, to move one of the points for that minimal value.

Link to comment
Share on other sites
Emmanuel Delay Proficient

Emmanuel Delay

Posted
Posted (edited)
On 8/4/2023 at 3:49 PM, labo said:

Hi everyone, Emmanuel, your lisp was very useful. I used it to take data from road cross section composed of lines and polylines and then together with other lisps create an external txt with station offset and height of each point in csection, so later i used civil 3d command to draw points from txt file on actual position in plan view, in 3d. Now a great thing would be that the points drawn are the same layer as line or polyline on whos ends this lisp drew points. This way i could create alot of points in each cross section, and by freezing layer by layer could create surfaces of subgrade, asphalt, subsoil etc... is it possible to achieve this without too much work? also, double points in this case are good.

 

 

Sure

  

(vl-load-com)

;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/
(defun drawPoint (pt)
 (entmakex (list (cons 0 "POINT")
                 (cons 10 pt))))
	 
				 
(defun very_close_together ( p1 p2 / )
  (if 
	(< (distance p1 p2) 0.000001)
	T
	nil
  )
)
				 
(defun delete_doubles ( points pts / i j p1 p2)

	(setq i 0)
	(repeat (length pts)
		(setq p1 (nth i pts))
		(setq j (+ i 1))
		(princ "\n")
		(while (nth j pts)
			(setq p2 (nth j pts))
			;; now check if p1 and p2 are the same point.  If so, then delete both
	
			(if (very_close_together  p1 p2 )
				(progn
					;;(entdel (nth i points ))
					(entdel (nth j points ))
				)
			)
			(setq j (+ j 1))
		)
		(setq i (+ i 1))
	)
)
				 
(defun c:pelp ( / ss i pt ent points pts lay curlay)
	(setq ss (ssget (list (cons 0 "LINE,POLYLINE,LWPOLYLINE"))))
	(setq i 0)
	(setq points (list))
	(setq pts (list))
	(setq curlay (getvar "CLAYER"))
	(repeat (sslength ss)
		(setq ent (ssname ss i))
		;; start point
		(setq pt (vlax-curve-getStartPoint (vlax-ename->vla-object ent)))
		(setq pts (append pts (list  pt)))
		(setq points (append points (list (drawPoint pt))))
		;; end point
		(setq pt (vlax-curve-getEndPoint (vlax-ename->vla-object ent)))
		(setq pts (append pts (list  pt)))
		
		;; read layer and set as current
		(setq lay (cdr (assoc 8 (entget ent))))
		(setvar "CLAYER" lay)
		(setq points (append points (list (drawPoint pt))))

		(setq i (+ i 1))
	)
	(delete_doubles  points pts)
	(setvar "CLAYER" curlay)
	(princ )
)

 

Edited by Emmanuel Delay
error in code
Link to comment
Share on other sites
labo Newbie

labo

Posted
Posted

and yes, cross sections are matched to a chainage along the alignment. I don't mind that in curves the surfaces are just interpolated data from cross sections, since i only need data from csections. Only positions where I need exact data in more detail between sections is when preparing survey to work on concrete gutters or retaining structures, but i have a good simple solutions for these positions.

Link to comment
Share on other sites
labo Newbie

labo

Posted
Posted

Hi Emmanuel, thanks for reply. Sorry to bother you, but it seems I am doing something wrong, it draws one point on layer of object i selected.

Link to comment
Share on other sites
Emmanuel Delay Proficient

Emmanuel Delay

Posted
Posted

Oops, I edited the last post, 

 

I had replaced 

(setq points (append points (list (drawPoint pt))))

with another function that I ended up scrapping.

 

Copy paste the code again please.

  • Like 1
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.

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