Jump to content

To get length of polyline from start to upto where i click

minejash

By minejash
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

minejash Explorer

minejash

Posted
Posted

Hai, i need a help in editing a lisp code. I have a working lisp routine which gives me perpendicular distance to main pline when clicked on a place perpendicular to the pline i selected. Only thing i want to change is i dont need perpendicular distance from main pline but i need same main pline distance(chainage) where i click.

 

Pls reply if its possible... thanks:)

 

Attaching the lisp file and also adding same lisp code below,

  

(defun c:CE (/ s p c a d tp sch)
(setvar "cmdecho" 0)
  (setq sch (getstring "\nSpecify start chainage : <0>"))			;"0" is set as the default value
  (if (= sch "")(setq sch "0"))
  (if
    (and (setq s (car (entsel "\nPick a polyline :")))
	 (or (= (cdr (assoc 0 (entget s))) "LWPOLYLINE")
	     (alert "Invalid object! Please pick a polyline only.")
	 )
    )
     (while
       (and
	 (setq
	   p (getpoint "\nSpecify point perpendicular to polyline :")
	 )
	 (setq c (vlax-curve-getclosestpointto s p))
	 (setq a (angle p c))
	 (not (grdraw p c 1 -1))
	 ;; rubber line in red colour.
	 (setq d (angle	'(0. 0. 0.)
			(vlax-curve-getfirstderiv
			  s
			  (vlax-curve-getparamatpoint s c)
			)
		 )
	 )
	 (or
	   (or (equal (rem (+ d (* pi 0.5)) (+ pi pi)) a 1e-4)
	       (equal (rem (+ d (* pi 1.5)) (+ pi pi)) a 1e-4)
	   )
	   (alert
	     "Picked point is not a perpendicular to picked polyline. <!>"
	   )
	 )
	 (setq tp (getpoint "\nSpecify Point for Text : "))
       )
		(command "_.LEADER" p tp "" 
				(strcat "CH=" sch "+" (rtos (vlax-curve-getdistatpoint s c) 2 3))
				(strcat "E=" (rtos (car p) 2 3))
				(strcat "N=" (rtos (cadr p) 2 3))
				""
		)
		(vlax-put-property (vlax-ename->vla-object (entlast)) 'height 0.60);;; Text Height 0.60
     )
  )
  (setvar "cmdecho" 1)
  (princ)
)
(vl-load-com)

 

COORD & CHAIN - FINAL AB.LSP

Isaac26a Collaborator

Isaac26a

Posted
Posted

Maybe  this can help you, it's a great program from Lee Mac.

BIGAL Grand Master

BIGAL

Posted
Posted

It is very easy there is a vl function note though it will be always from start of pline. A quicky effort

  

(defun c:getdist ( / oldsnap pt ent)
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 512)
(setq ent (entsel "Pick obj"))
(while (setq pt (getpoint "\nPick point Enter to exit"))
(princ (vlax-curve-getdistatpoint (vlax-ename->vla-object (car  ent)) pt))
)
(setvar 'osmode oldsnap)
(princ)
)

 

 

  • Like 1
ronjonp Grand Master

ronjonp

Posted
Posted (edited)
On 6/3/2021 at 6:18 PM, BIGAL said:

It is very easy there is a vl function note though it will be always from start of pline. A quicky effort

  



(defun c:getdist ( / oldsnap pt ent)
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 512)
(setq ent (entsel "Pick obj"))
(while (setq pt (getpoint "\nPick point Enter to exit"))
(princ (vlax-curve-getdistatpoint (vlax-ename->vla-object (car  ent)) pt))
)
(setvar 'osmode oldsnap)
(princ)
)

 

 

@BIGAL

No need to convert the entity to an object, the curve functions are actually faster with enames. 

(vlax-curve-getdistatpoint (car  ent) pt)
_$ 
Benchmarking ....................Elapsed milliseconds / relative speed for 131072 iteration(s):

    (vlax-curve-getDistAtPoint E P)..............1656 / 4.43 <fastest>
    (vlax-curve-getDistAtPoint (vlax-ena...).....7344 / 1.00 <slowest>

 
; 1 form loaded from #<editor "<Untitled-0> loading...">
_$

 

Edited by ronjonp
  • Like 1
minejash Explorer

minejash

Posted
  • Author
Posted

its not working as i wanted, but its giving output, Thank You.

 

i have a lisp code here, its working in polyline but not points above it. when i use measure command to the polyline, the points are created . when i pick the points to get the chainage ,its showing error. is it possible to get polyline length even if i click the points above it? Please check if possible. other than that the lisp is working wonderfully. hak_vz helped in it. 

(defun c:CE (/ s p c tp sch f)
(setvar "cmdecho" 0)
 (setq sch (getstring "\nSpecify start chainage : <0>"))			;"0" is set as the default value
  (if (= sch "")(setq sch "0"))
  (if
    (and (setq s (car (entsel "\nPick a polyline :")))
	 (or (= (cdr (assoc 0 (entget s))) "LWPOLYLINE")
	     (alert "Invalid object! Please pick a polyline only.")
	 )
    )
     (while
       (and
	 (setq
	   p (getpoint "\nSpecify point :")
	 )
	 (setq c (vlax-curve-getclosestpointto s p))
	 	 (setq tp (getpoint "\nSpecify Point for Text : "))
       )
	  (setq di (vlax-curve-getdistatpoint s p))
	  (setq f (fix (/ di 1000.0)))
	  (setq di (- di (*  f 1000.0)))
		(command "_.LEADER" p tp "" 
				(strcat "CH=" (itoa (+ (atoi sch) f)) "+" (rtos di 2 3))
				""
		)
		(vlax-put-property (vlax-ename->vla-object (entlast)) 'height 0.60);;; Text Height 0.60
     )
  )
  (setvar "cmdecho" 1)
  (princ)
)

 

CHAIN.PNG

hosneyalaa Community Regular

hosneyalaa

Posted
Posted
1 hour ago, minejash said:

its not working as i wanted, but its giving output, Thank You.

 

i have a lisp code here, its working in polyline but not points above it. when i use measure command to the polyline, the points are created . when i pick the points to get the chainage ,its showing error. is it possible to get polyline length even if i click the points above it? Please check if possible. other than that the lisp is working wonderfully. hak_vz helped in it. 


(defun c:CE (/ s p c tp sch f)
(setvar "cmdecho" 0)
 (setq sch (getstring "\nSpecify start chainage : <0>"))			;"0" is set as the default value
  (if (= sch "")(setq sch "0"))
  (if
    (and (setq s (car (entsel "\nPick a polyline :")))
	 (or (= (cdr (assoc 0 (entget s))) "LWPOLYLINE")
	     (alert "Invalid object! Please pick a polyline only.")
	 )
    )
     (while
       (and
	 (setq
	   p (getpoint "\nSpecify point :")
	 )
	 (setq c (vlax-curve-getclosestpointto s p))
	 	 (setq tp (getpoint "\nSpecify Point for Text : "))
       )
	  (setq di (vlax-curve-getdistatpoint s p))
	  (setq f (fix (/ di 1000.0)))
	  (setq di (- di (*  f 1000.0)))
		(command "_.LEADER" p tp "" 
				(strcat "CH=" (itoa (+ (atoi sch) f)) "+" (rtos di 2 3))
				""
		)
		(vlax-put-property (vlax-ename->vla-object (entlast)) 'height 0.60);;; Text Height 0.60
     )
  )
  (setvar "cmdecho" 1)
  (princ)
)

 

CHAIN.PNG

 

REPLACE THIS 

(setq di (vlax-curve-getdistatpoint s p))

 

WITH THIS 

(setq di (vlax-curve-getdistatpoint s c))

 

Capture.JPG

  • Like 1
minejash Explorer

minejash

Posted
  • Author
Posted

Thank you. it works well now... Thanks

CADWORKER Enthusiast

CADWORKER

Posted
Posted

image.png.0c2b23e7057909982cf5edbf880fdf5f.png

 

Its a great code, Thanks all for this. I have a small request to make

can the text be further formatted to 00+000.000 instead of 0+00.000

 

Thanks in advance

hosneyalaa Community Regular

hosneyalaa

Posted
Posted
3 hours ago, CADWORKER said:

image.png.0c2b23e7057909982cf5edbf880fdf5f.png

 

Its a great code, Thanks all for this. I have a small request to make

can the text be further formatted to 00+000.000 instead of 0+00.000

 

Thanks in advance

 

REPLACE this

(if (= sch "")(setq sch "0"))

 

With this

 

(if (= sch "")(setq sch "00"))

 

CADWORKER Enthusiast

CADWORKER

Posted
Posted
41 minutes ago, hosneyalaa said:

 

REPLACE this

(if (= sch "")(setq sch "0"))

 

With this

 

(if (= sch "")(setq sch "00"))

 

hosneyalaa, thanks for your help. But its not showing any difference in results.

hosneyalaa Community Regular

hosneyalaa

Posted
Posted
1 hour ago, CADWORKER said:

hosneyalaa, thanks for your help. But its not showing any difference in results.

 

And

REPLACE

 

(strcat "CH=" (itoa (+ (atoi sch) f)) "+" (rtos di 2 3))

 

With

 

(strcat "CH=" (itoa (+ (atoi sch) f)) "+0" (rtos di 2 3))

CADWORKER Enthusiast

CADWORKER

Posted
Posted
22 minutes ago, hosneyalaa said:

 

And

REPLACE

 

(strcat "CH=" (itoa (+ (atoi sch) f)) "+" (rtos di 2 3))

 

With

 

(strcat "CH=" (itoa (+ (atoi sch) f)) "+0" (rtos di 2 3))

image.png.473138e6f08d9d1092fa65e34caef1f8.png

 

Here the values less than 100 are good, but 100 and above are not true...

please look into this..

Thanks for all your time and efforts..

  • 2 years later...
kidznok Newbie

kidznok

Posted
Posted
On 6/5/2021 at 9:30 AM, hosneyalaa said:

 

REPLACE THIS 

(setq di (vlax-curve-getdistatpoint s p))

 

WITH THIS 

(setq di (vlax-curve-getdistatpoint s c))

 

Capture.JPG


Thank you very much. Works excellent.

I have 2 question
Is it chance to have text perpendicular to polyline ?


And more difficult is it possible to add this lisp to block?
image.thumb.png.07e3699caddedb981c1250501e6282d4.png
I would like to put block and attribute of block will have a station on this point.

Once again thank you :)
All best 

kidznok Newbie

kidznok

Posted
Posted
On 6/6/2021 at 2:03 PM, CADWORKER said:

image.png.473138e6f08d9d1092fa65e34caef1f8.png

 

Here the values less than 100 are good, but 100 and above are not true...

please look into this..

Thanks for all your time and efforts..


I'm just trying to change that but I don't know autolisp code 😕

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