Pavement Investigation Report

[Automohan]

Dear Colleagues;

I have to make Pavement Investigation Report on road profile from the excel data from our Senior Pavement Consultant Engineer.

1.) First need to insert texts with Justify = Middle Center, Text height = 7.5, Angel = 90, interval 50m with the text behind polyline Global width 50 & choose now color 253 as shown in the attached example dwg. from the notepad data

2.) Second when I select each text with its polyline behind the polyline color should change as per the text value

3.) Color changing has 2 items one is IRI Values second is PCI Values as shown in the attached example dwg

Thanks

Note: Reading the text value & changing the polyline color behind the text need multiple selection is far better because it is 230 Km Road

[Automohan]

Some of the Outbound PCI data only i have copied to Notepad from the full Pavement data of excel file

[Automohan]

This is just a start that will read values from notepad & insert as text but missing is

1.) texts should insert in 50m intervals horizontal with single row

2.) Create a polyline behind the texts (Polyline Global width 50, Length 39.5, color 253)

(defun c:pavement-report ( / ent file dist dis )
(vl-load-com)
(setq file (open "D:\\Outbound PCI data.txt" "r"))
(setq pt '(0 0 0))
(setq pt+50     Need to update  
(while (setq dist (read-line file))
  (setq dis (distof dist))
 (command "text" "_J" "_MC" pt+50 7.5 90 dis "")) (princ))

[Automohan]

Inserting text & polylines are done, the only thing is to read the text value & change the polyline color

Multiple selection is preferred

Note: No need of writing the text color below as shown

[Moshe-A]

@Automohan hi,

Give this PCI command a try 😀

lines 53-57 defines some constant that controls every length (plus the color) in the program. you can change these values to get other result. you can multiply these values by dimscale to support other scale.

lines 70-73 eliminate spaces around the read record. 

lines 80-81 will skip empty records or ones who starts with semicolon ';' character. Yes, you can add comment lines by starting it with semicolon

; this is comment line

line 84 verifies that the record is real number. 

Note the use of (entmake) function in  (draw_pline) + (draw_text) as opposed to using the (command) function. this gives you real speed 😀

enjoy

Moshe

(defun c:pci (/ _numchk draw_pline draw_text ; local functions
	        INTERVAL BCKGRDCOLOR BCKGRDLEN TEXTHGT fname f base rec p1 p2)

 ; anonymous function 
 (setq _numchk (lambda (s) (vl-every (function (lambda (n) (or (= n 46) (and (>= n 48) (<= n 57))))) (vl-string->list s)))) 
  
 (defun draw_pline (lst)
  (entmakex
    (append
     (list '(0   . "LWPOLYLINE")
           '(100 . "AcDbEntity")
           '(100 . "AcDbPolyline")
	    (cons '8 (getvar "clayer"))
	    (cons '62 BCKGRDCOLOR)
	    (cons '43 INTERVAL)
            (cons '90 (length lst))
           '(70 . 128)
     ); list
     (mapcar
      '(lambda (pt)
        (cons '10 pt)
       )
       lst
     )
    )
  ); entmake
 ); draw_pline


 (defun draw_text (pt str)
  (entmake
    (list
     '(0   . "TEXT")
     '(100 . "AcDbEntity")
     '(100 . "AcDbText")
      (cons '8 (getvar "clayer"))
      (cons '7 (getvar "textstyle"))
     '(10 0.0 0.0 0.0) ; dummy but mandatory
      (cons '11 pt)
      (cons '40 TEXTHGT)
      (cons '50 (/ pi 2))
     '(72 . 4) ; hor cen
     '(73 . 2) ; ver cen
      (cons '1 str)
    ); list
  ); entmake
 ); draw_text

  
 ; here start c:pci 
 (vla-startUndoMark (vla-get-activedocument (vlax-get-acad-object)))

 ; some constants 
 (setq INTERVAL 50)
 (setq BCKGRDCOLOR 253) ; background color
 (setq BCKGRDLEN 39.5)  ; background length
 (setq TEXTHGT 7.5)     ; text height
  
  
 (if (and
       (setq fname (getfiled "Select OutBound PCI File" (getvar "dwgprefix") "txt" 8)) ; select existing file
       (setq f (open fname "r")) ; open file for read
       (setq base (getpoint "\nRoad profile base point: "))
     )
  (progn
   (setq p1 (polar base 0.0 (/ INTERVAL 2)) i 0)
   
   (while (setq rec (read-line f))
     
    ; remove spaces from start + end of line record
    (foreach spc '(" " "\t") 
     (setq rec (vl-string-left-trim  spc rec))
     (setq rec (vl-string-right-trim spc rec))
    )		 

    (cond
     ((and
        (not
          (or
            (eq rec "")  	      ; skip empty record
            (eq (substr rec 1 1) ";") ; skip records starting with comment line
          )
	)
	(_numchk rec)
      )
      (setq p2 (polar p1 (/ pi 2) BCKGRDLEN))
      (draw_pline (list p1 p2))
      (setq p2 (polar p1 (/ pi 2) (/ BCKGRDLEN 2)))
      (draw_text p2 rec)
      (setq p1 (polar base 0.0 (+ (/ INTERVAL 2) (* (setq i (1+ i)) INTERVAL))))	; advance pointer
     ); case
     ( t
      ; reserved
      nil
     )
    ); cond
     
   ); while
   (setq f (close f)) ; close file
  ); progn
 ); if

 (vla-endUndoMark (vla-get-activedocument (vlax-get-acad-object)))
  
 (princ)
); c:pci

[Moshe-A]

@Automohan ,

Yes added colors and make sure to set arial textstyle current.

(defun c:pci (/ _numchk draw_pline draw_text ; local functions
	        INTERVAL BCKGRDCOLOR BCKGRDLEN TEXTHGT fname f base rec p1 p2 i j)

 ; anonymous function 
 (setq _numchk (lambda (s) (vl-every (function (lambda (n) (or (= n 46) (and (>= n 48) (<= n 57))))) (vl-string->list s)))) 
  
 (defun draw_pline (lst / spin_color_wheel)
   
  (defun spin_color_wheel ()
   (if (= j (1- (length BCKGRDCOLOR)))
    (setq j -1)
   )
    
   (nth (setq j (1+ j)) BCKGRDCOLOR)  
  ); spin_color_wheel
   
  (entmake
    (append
     (list '(0   . "LWPOLYLINE")
           '(100 . "AcDbEntity")
           '(100 . "AcDbPolyline")
	    (cons '8 (getvar "clayer"))
	    (cons '62 (spin_color_wheel))
	    (cons '43 INTERVAL)
            (cons '90 (length lst))
           '(70 . 128)
     ); list
     (mapcar
      '(lambda (pt)
        (cons '10 pt)
       )
       lst
     )
    )
  ); entmake
 ); draw_pline


 (defun draw_text (pt str)
  (entmake
    (list
     '(0   . "TEXT")
     '(100 . "AcDbEntity")
     '(100 . "AcDbText")
      (cons '8 (getvar "clayer"))
      (cons '7 (getvar "textstyle"))
     '(10 0.0 0.0 0.0) ; dummy but mandatory
      (cons '11 pt)
      (cons '40 TEXTHGT)
      (cons '50 (/ pi 2))
     '(72 . 4) ; hor cen
     '(73 . 2) ; ver cen
      (cons '1 (rtos (atof str) 2 3))
    ); list
  ); entmake
 ); draw_text

  
 ; here start c:pci 
 (vla-startUndoMark (vla-get-activedocument (vlax-get-acad-object)))

 ; some constants 
 (setq INTERVAL 50)
 (setq BCKGRDLEN 39.5)  ; background length
 (setq TEXTHGT 7.5)     ; text height
 (setq BCKGRDCOLOR '(104 31 40 123 40 231 10 40 252))
  
 (if (and
       (setq fname (getfiled "Select OutBound PCI File" (getvar "dwgprefix") "txt" 8)) ; select existing file
       (setq f (open fname "r")) ; open file for read
       (setq base (getpoint "\nRoad profile base point: "))
     )
  (progn
   (setq p1 (polar base 0.0 (/ INTERVAL 2)) i 0 j -1)
   
   (while (setq rec (read-line f))
     
    ; remove spaces from start + end of line record
    (foreach spc '(" " "\t") 
     (setq rec (vl-string-left-trim  spc rec))
     (setq rec (vl-string-right-trim spc rec))
    )		 

    (cond
     ((and
        (not
          (or
            (eq rec "")  	      ; skip empty record
            (eq (substr rec 1 1) ";") ; skip records starting with comment line
          )
	)
	(_numchk rec)
      )
      (setq p2 (polar p1 (/ pi 2) BCKGRDLEN))
      (draw_pline (list p1 p2))
      (setq p2 (polar p1 (/ pi 2) (/ BCKGRDLEN 2)))
      (draw_text p2 rec)
      (setq p1 (polar base 0.0 (+ (/ INTERVAL 2) (* (setq i (1+ i)) INTERVAL)))) ; advancing pointer
     ); case
     ( t
      ; reserved
      nil
     )
    ); cond
     
   ); while
   (setq f (close f)) ; close file
  ); progn
 ); if

 (vla-endUndoMark (vla-get-activedocument (vlax-get-acad-object)))
  
 (princ)
); c:pci

[Automohan]

Thanks Moshe for your time spending for me but the color should work this way as per the values

Example below image:

[Moshe-A]

@Automohan ,

first does it works for you?

second in your previous respnd there was 9 colors now only 7

create the chart\color bar again each color with it value range

Moshe

[marko_ribar]

Duplicate post :

http://www.theswamp.org/index.php?topic=58133.0 

Isn't that what's you're looking for...^^^

[Automohan]

Yes, marko

[Automohan]

Yes, inserting text values & it's polyline with 50m interval is fine done, the only issue is with changing colors

I have rechecked sure there were only 7 colors, don't consider color no 253 it is just for example use.

Have a look through the attached sample dwg which is done manually there were also possible human errors,

you can see the color bar vs text values in the Legend:

we have 2 color range vs text values one is PCI other is IRI mention in the Legend

Sorry for my English, I hope it is clear enough

[Moshe-A]

@Automohan ,

fixed

[Automohan]

I have tried maximum to find the error but could not

"It is only asking the text file path to load then it exit"

I hope the error was somewhere here!

(cond ((not (setq fname (getfiled "Select OutBound PCI File" (getvar "dwgprefix") "txt" 8)))) ; select existing file
       ((not (and (eq (vl-filename-directory fname) "")   
                  (setq fname (strcat (getvar "dwgprefix") fname))))); case
       ((not (and (setq f (open fname "r")) ; open file for read
                  (setq base (getpoint "\nRoad profile base point: "))))); case
  ( t (setq p1 (polar base 0.0 (/ INTERVAL 2)) i 0)
   
   (while (setq rec (read-line f))
     
    ; remove spaces from start + end of line record
    (foreach spc '(" " "\t") 
     (setq rec (vl-string-left-trim  spc rec))
     (setq rec (vl-string-right-trim spc rec)))		 

    (cond ((and (not (or (eq rec "")  	             ; skip empty record
                         (eq (substr rec 1 1) ";"))) ; skip records starting with comment line
              	(_numchk rec))
      (setq p2 (polar p1 (/ pi 2) BCKGRDLEN))
      (draw_pline (list p1 p2) (atof rec))
      (setq p2 (polar p1 (/ pi 2) (/ BCKGRDLEN 2)))
      (draw_text p2 rec)
      (setq p1 (polar base 0.0 (+ (/ INTERVAL 2) (* (setq i (1+ i)) INTERVAL)))) ; advancing pointer
     ); case
     ( t ; reserved
      nil ); case
    ); cond
   ); while
   (setq f (close f)) ; close file
  ); case
 ); cond

[Moshe-A]

make sure the file is opened

[Moshe-A · Accepted solution]

@Automohan ,

sorry you were right, here is a fix