Need Little Help To Fix My Lisp File

Dear ...

big bros

I need Little Help to Fix My Lisp file ...

i am Trying to create Chainage Lisp file and i succeed to Put "_POINT" to Polyline with given Interval

But here i have one Problem how to insert Tick Mark Means PERPENDICULAR LINE to Every Point ....i tried lots of time ...but its fails ......please help to learn how to insert lines ....Explain me bit wise please

i used render man Sub function i dnt know where i want to use this

(defun _GetPerpAng (startPoint endPoint add)
 (+ (* (if add 0.50 -0.50) pi) (angle startPoint endPoint))
)

My Code :

;;Chainge Distance 

(defun *error* (msg)
 (if (not
(member msg '("Function cancelled" "quit / exit abort"))
     )
   (princ (strcat "\nError: " msg))
 )
 (setvar "CMDECHO" old_cmh)
 (setvar "osmode" old_osm)
 (setvar "clayer" old_lay)
 (princ)
)

(defun c:Chainage()
 (vl-load-com)
 (setq old_cmh(getvar "cmdecho"))
 (setq old_osm(getvar "osmode"))
 (setq old_lay(getvar "clayer"))
 (setvar "cmdecho" 0)
 (setvar "osmode" 0)
 (if (setq ss(car(entsel "\nPick Polyline >>")))
   (progn
   (setq interval(getreal "\nEnter Chainage Interval:"))
   (setq Nxt_dist interval)
   (setq pl_len(vlax-curve-getdistatparam ss(vlax-curve-getendparam ss)))
   (setq spt(vlax-curve-getstartpoint ss))
   (setq ept(vlax-curve-getendpoint ss))
   (command "_POINT" spt)(command "_POINT" ept)
   (repeat
      (fix(/ pl_len interval))
	  (setq M_point(vlax-curve-getpointatdist ss interval))
	  (command "_POINT" M_point)
	  (setq interval(+ nxt_dist interval))
   )
)
 (princ "\nNo Polyline Selected:")
 )
 (setvar "cmdecho" old_cmd)
 (setvar "osmode" old_osm)
 (setvar "clayer" old_lay)
 (princ)
)
  
	  

waiting for your answers .......

Find my attachment

CHAINAGE.dwg

Are you wanting to put a tick instead of a point on the interval? or both?

Why not use DIVIDE/MEASURE command and use block for intervals? or am i missing something?

Dear pBe i dont want to use Pint For Example i used that object ...but my requirement is i want to insert Line tick mark and also i need to put distance text to each points .........

Pardon for my ignorance. what will the final drawing look like? Chainage is all greek to me.

-A picture is worth a thousand words-

EDIT: oops... i did not see your post there gs7

A chainage line (the Pline) is always straight? Then a block with attributes is the way to go in this case.

Except the first and last point that is.

Hang on... guess you can use your lisp then.... but i'm more inclined to use an attribute block

My attachment

CHAINAGE.dwg

Hang in there, i will help you fix your lisp, we will still use your original approach so you may understand it better.

oh! tank u pbe ...i will wait for reply

(defun c:Chainage (/ *error*   _GetPerpAng	   ss	     interval
	     Nxt_dist  pl_len	 scale_	   points    spt
	     ept       mpoint	 M_point   cur
	    )
(defun *error* (msg)
(command "._undo" "_end")  
 (if (not
(member msg '("Function cancelled" "quit / exit abort"))
     )
   (princ  msg)
 )
 (setvar "CMDECHO" old_cmh)
 (setvar "osmode" old_osm)
 (setvar "clayer" old_lay)
 (setvar "attreq" old_atq)
 (princ)
)  
(defun _GetPerpAng (startPoint endPoint add)
 (+ (* (if add 0.50 -0.50) pi) (angle startPoint endPoint))
)
[color="blue"](defun rtd (a)
(/ (* a 180.0) pi)
)  [/color]
 (vl-load-com)
 (setq old_cmh (getvar "cmdecho"))
 (setq old_osm (getvar "osmode"))
 (setq old_lay (getvar "clayer"))
 (setq old_atq (getvar "attreq"))
 (setvar "cmdecho" 0)
 (command "._undo" "_begin")
 (setvar "osmode" 0)
 (setvar "attreq" 1)
 
 (if[color="blue"] (and[/color] (setq ss (car(entsel "\nPick Polyline >>")))
   (setq interval (getdist "\nEnter Chainage Interval: "))
     	  [color="blue"] (setq scale_ (getreal "\nEnter Block Scale: "))[/color]
   [color="blue"])[/color]
   (progn
         [color="blue"] (setq points (mapcar 'cdr (vl-remove-if-not '(lambda (j)
                              ( = (car j) 10)) (setq ent (entget ss)))))[/color]
   (setq Nxt_dist interval)
   (setq pl_len	  (vlax-curve-getdistatparam ss
		    (vlax-curve-getendparam ss)
		  )
	 [color="blue"]Interval (- Interval)
	 spt	  (car points)
	 ept	  (cadr points)[/color]
   )
   (repeat (+ (fix (/ pl_len (abs interval))) 2)
   (setq interval (+ nxt_dist interval)
	[color="blue"] interval (if (> interval pl_len) pl_len interval)) [/color] 
          (setq M_point (vlax-curve-getpointatdist ss interval))
  [color="blue"] (if (> (vlax-curve-getDistAtPoint ss M_point)(vlax-curve-getDistAtPoint ss ept))
	  (setq	points (cdr points)
		spt    (car points)
		ept    (cadr points)))   [/color]				
   (command "_insert" "label" M_point[color="blue"] scale_ 
		(rtd (_GETPERPANG spt ept nil))
	     (setq cur (strcat "Ch:" (rtos interval 2 0) "m")))
   (print cur)  [/color]
   )
C      )
 (princ "\nNo Polyline Selected:")
 )
 (*error* "")
 (princ)
)

Insert this block om your drawing

label.dwg

CODE UPDATED:

A chainage line (the Pline) is always straight?

dear pbe the code u posted its working perfectly when the chainage line is straight

Sorry pBe i did not Notice what u have asked , the chainage line straight or not

and also i have made a mistake i.e i attached straight line drawing ....

sorry for ignorance .......

actually i am using Road Center line as my chainage line ....... so that line is having so many curve points ........

please find my another attachment .........

Chainage-2.dwg

See updated code gS7,

The placement of the labels ( blocks ) will depend on the direction of the polyline.

Keep on coding

Nice work pbe ..

its working perfect now m going to study this lisp file ,

i have lots of doubts , and i hope this file will solve my doubts

thank u pBe

Nice work pbe ..

its working perfect now m going to study this lisp file ,

thank u pBe

You are welcome, If i had to re-write the code it will look different from what you have now.

Nice work pbe ..

.....i have lots of doubts , and i hope this file will solve my doubts.....

Go and satisfy your "doubts" away gS7

(defun c:Ch()
   (setq Pl1Name (car (entsel"\nPick Centerline ")))
   (setq StaInterval (getreal "\nEnter Chainage Interval "))
   (setq MarkLength (getreal "\nEnter Tick Length "))
   (setq CurrStation StaInterval) 
   (setq MaxLength (vlax-curve-getDistAtPoint Pl1Name (vlax-curve-getEndPoint Pl1Name)))
   (setq currLayer (getvar "CLAYER"))
 
   (while (< CurrStation MaxLength)
        (setq currPoint (vlax-curve-getPointAtDist Pl1Name currStation)
              currParam (vlax-curve-getParamAtDist Pl1Name currStation)
              PerpAng (dkb_getPerp Pl1Name currParam 1)
              Pt1 (polar currPoint PerpAng (* MarkLength 0.5))
              Pt2 (polar currPoint PerpAng (* MarkLength -0.5))
              currStation (+ currStation StaInterval)
              LineList (list
                         '(0 . "LINE")
                         '(100 . "AcDbEntity")
                         '(100 . "AcDbLine")
                         (cons 8 currLayer)
                         (cons 10 Pt1)
                         (cons 11 Pt2)
                    );list
        );setq
        (entmake LineList)
   
   );while

); defun chainageMark

(defun dkb_getPerp (pCurve pParam pDir )
   ;; function to return the perpindicular angle of a Pline at a given parameter and a direction left or right based
   ;; on looking up-station left=-1  right = 1
   
   (setq oCurve (dkb_getOrCreateVlaObject pCurve)
         zeroPt '(0.0 0.0 0.0)
         deg90 (atan 1 0)
         FirstDeriv (vlax-curve-getFirstDeriv oCurve pParam)
         ang1 (angle zeroPt FirstDeriv)
         ;;correct for the desired side of the line
         ang1 (+ ang1 (* -1 pDir deg90))
   );setq
);defun end function dkb_getPerp

(defun dkb_GetOrCreateVlaObject(pEntOrObj)
    (if (not (equal (type pEntOrObj) 'VLA-OBJECT))
      (setq oPl (vlax-ename->vla-object pEntOrObj))
      (setq oPl pEntOrObj)
    ); if
   oPl
);defun dkb_GetorCreateVlaOjbect

(prin1);load cleanly

Please check this lisp file pbe

I knew i've seen that before.

http://www.theswamp.org/index.php?topic=24602.msg296773#msg296773

hence

If i had to re-write the code it will look different from what you have now.

But i would've still use an Attribute block if a label is required in place of TEXT/MTEXT.

Hope you also learn from that code gS7

Keep on coding

setq oCurve (dkb_getOrCreateVlaObject pCurve)
         zeroPt '(0.0 0.0 0.0)
         deg90 (atan 1 0)
         FirstDeriv (vlax-curve-getFirstDeriv oCurve pParam)
         ang1 (angle zeroPt FirstDeriv)
         ;;correct for the desired side of the line
         ang1 (+ ang1 (* -1 pDir deg90))
   );setq
);defun end function dkb_getPerp

(defun dkb_GetOrCreateVlaObject(pEntOrObj)
    (if (not (equal (type pEntOrObj) 'VLA-OBJECT))
      (setq oPl (vlax-ename->vla-object pEntOrObj))
      (setq oPl pEntOrObj)
    ); if
   oPl
);defun dkb_GetorCreateVlaOjbect

(prin1);load cleanly

pBe i tried to understand above sub function ......but its so much irritating me ....please explain me y he used those sub functions ......

dkb_GetOrCreateVlaObject

This sub will convert an 'Ename object to VLA-object, not that you need that in this case as Vlax-curve functions works on ename

To see where the points are

(defun c:demo ()
 (setq oCurve (car (entsel)))
 (setq StaInterval (getreal "\nEnter Chainage Interval "))
 (Setq	zeroPt	   '(0.0 0.0 0.0)
FirstDeriv (vlax-curve-getFirstDeriv ;<-- this is key   
	     oCurve
	     (vlax-curve-getParamAtDist oCurve StaInterval)
	   )
ang1	   (angle zeroPt FirstDeriv)
ang1	   (+ ang1 (/ pi 2.0);<--- 90 degree in radians
		      )) 
 )
 (command "_line"
   "_non"
  [b] (Setq pt (vlax-curve-getPointAtDist oCurve StaInterval))[/b]
   "_non"
   (polar[b] pt[/b] ang1 StaInterval)
   ""
 )
)

pBe your are fantastic .....

woooooow !!!! now i understood .....the codes .....

i am really thankful to you .....

(Alert "I am Really Happy :)")

Good Day pbe

With your Help ...i completed my Chainage Lisp Tanq u .....

please check once if any mistake in code please clarify to me i.e where i done wrong

;;Create Chainage with Given Interval  

(defun c:Chainage ()
 ;error handler
 (defun *error* (msg) 
      (if (not
     (member msg '("Function cancelled" "quit / exit abort")))
	 (princ msg)
   );if
      (setvar "CMDECHO" old_cmh)
      (setvar "osmode" old_osm)
      (setvar "clayer" old_lay)
      (setvar "attreq" old_atq)
     (princ)
 );defun
 (vl-load-com)
 (setq old_cmh (getvar "cmdecho"))
 (setq old_osm (getvar "osmode"))
 (setq old_lay (getvar "clayer"))
 (setq old_atq (getvar "attreq"))
 (setvar "cmdecho" 0)
 (setvar "osmode" 0)
 (setvar "attreq" 1)
 (if 
   (and
   (setq pl_set(car (entsel "\nPick PolyLine >>:")))
   (setq Interval(getreal "\nEnter Chainage Interval:"))
   (setq Tick_length(getreal "\nEnter Chainage Tick Mark Length:"))
)
(progn
  (_Layer "CH_Mark" 1)
  (_Layer "CH_Text" 2)
  (setq Incr Interval)
  (setq Pl_length(vlax-curve-getdistatparam pl_set (vlax-curve-getendparam pl_set)))
  (Start_Point pl_set Interval Tick_length)
  (repeat (fix (/ Pl_Length Interval))
        (setq Incr_pt (vlax-curve-getPointAtDist pl_set interval))
	(setq Ang(Param_ang pl_set Interval))
	(setq Tick1(/ Tick_length 2))
        (setq Tick2(- Tick1))
	(setq L(Polar Incr_Pt Ang Tick1))
               (setq R(Polar Incr_Pt Ang Tick2))
	(line L R "CH_Mark")
               (_Text l 0.1 (getvar "TEXTSTYLE") (strcat "ch:"(rtos Interval 2 3) "m") "CH_Text" ang)
	(setq Interval(+ incr Interval))
  );repeat
 );progn
);if
(setvar "cmdecho" old_cmh)
   (setvar "osmode" old_osm)
(setvar "clayer" old_lay)
   (setvar "attreq" old_atq)
(*error* "")
  );defun
  
  

  
(defun Start_Point(ocurve incr Tickmark / spt Rot_ang Tick1 Tick2 l R Ch0)
  (setq spt(vlax-curve-getstartpoint ocurve))
  (setq Rot_ang(param_ang ocurve incr))
  (setq Tick1(/ Tickmark 2))
  (setq Tick2(- Tick1))
  (setq L (polar spt Rot_ang Tick1))
  (setq R (Polar Spt Rot_ang Tick2))
  (line L R "CH_Mark")
  (setq ch0 0.0)
  (_Text l 0.1 (getvar "TEXTSTYLE") (strcat "Ch:"(rtos ch0 2 3) "m") "CH_Text" Rot_ang)
 );defun 
  
  

(defun Line (p1 p2 Layer)
 (entmakex (list (cons 0 "LINE")
                 (cons 10 p1)
                 (cons 11 p2)
	  (cons 8 Layer))))



(defun Param_ang (oCurve StaInterval / Zeropt Firstderiv ang1 ang2)
     (setq zeropt (list 0.0 0.0 0.0))
     (setq FirstDeriv
     (vlax-curve-getFirstDeriv
       oCurve
       (vlax-curve-getParamAtDist oCurve StaInterval)
     )
     )
     (setq ang1 (angle zeroPt FirstDeriv))
     (setq ang2 (+ ang1 (/ pi 2.0)))
     
   )


(defun _Layer (LayerName Color )
 (entmake (list (cons 0 "LAYER")
	 (cons 100 "AcDbSymbolTableRecord")
	 (cons 100 "AcDbLayerTableRecord")
	 (cons 2 LayerName)
	 (cons 70 0)
	 (cons 62 Color))
 )
)


(defun _Text (coord ht style name layer Rot)
 (entmake (list (cons 0 "TEXT")
	         (Cons 10 coord)
	         (cons 40 ht)
	         (cons 7 style)
	         (cons 1 name)
	         (cons 8 layer)
                 (cons 50 rot)
	)
  )
)
  

minor points

localize your variables

(defun c:chainage ( / pl_set Interval Tick_length....)

unless you are using the variables for default values

no need to get/set "clayer" as you're not changing the current layer anywhere in your code

unless you are setting the current layer before you invoke the line and text subs.

(setvar 'clayer "CH_Text") before the text creation

(setvar 'clayer "CH_Mark") before the line creation

but i can see you set it to assign the layer upon text/line creation. so it could one or the other but not both

no need get/set "attreq" as you're not using "insert" command anywhere in your code

resetting the system variables you do use will be taken care of by the *error* function so you dont need to reset them before the end

(setvar "cmdecho" old_cmh);

(setvar "osmode" old_osm) ;

(setvar "clayer" old_lay) ;

(setvar "attreq" old_atq) ;

(*error* "")

if you only need to invoke a function one time there's no point of creating a sub

(line L R "CH_Mark") , ..... I'm guilty of that myself at times....

it would be proper to give credit to the original author "copied as it is" or otherwise

(defun dkb_getPerp (.....

Keep on coding

Hello pbe ...

Sorry i was went to native for celebrate Festival ... So I Could not Give Answer Right Time to (#19)

i corrected everything which you mentioned Error Correction in #19 post ........

and Tank u for Your Suggestion