Lisp to add vertices to polyline

[vishshreevT578L]

Good Day

I am looking for a lisp or a easier way to add vertices to a polyline at user specified distance from an external distance file

attached are the files

thanks

[hak_vz]

Sorry I don't have time to play with Excel data entry but I guess this is what you need

(defun c:addborehole ( / e eo i tot boreholes p)
	(setq boreholes '(
		("BHCR-01" 	370.0)
		("BHCR-02"	0568.0)
		("BHCR-03"	0785.0)
		("BHCR-04"	2065.0)
		("BHCR-05"	2265.0)
		("BHCR-06" 4100.0)
		("BHCR-07" 6075.0)
		("BHCR-08" 8570.0)
		("BHCR-09" 9410.0)
		("BH-10" 12400.0)
		("BHCR-11"	14690.0)
		("BH-12" 17500.0)
		("BH-13" 20500.0)
		("BH-14" 23500.0)
		("BH-15" 26500.0)
		("BH-16" 29500.0)
		("BH-17" 32500.0)
		("BH-18" 35500.0)
		("BH-19" 38500.0)
		("BHT-20" 40500.0)
		("BHT-21" 41000.0)
		("BHT-22" 41500.0)
		("BHT-23" 42000.0)
		("BHT-24" 42500.0)
		("BHT-25" 43000.0)
		("BHT-26" 43500.0)
		("BHT-27" 44000.0)
		("BHT-28" 44500.0)
		("BHT-29" 45000.0)
		("BHT-30" 45500.0)
		("BHT-31" 46000.0)
		("BHT-32" 46500.0)
		("BHT-33" 47000.0)
		("BHT-34" 47500.0)
		("BHT-35" 48000.0)
		("BHT-36" 48500.0)
		("BHT-37" 49000.0)
		("BHT-38" 49500.0)
		("BHT-39" 50000.0)
		("BHT-40" 50500.0)
		("BHT-41" 52000.0)
		("BHT-42" 52250.0)
		("BHT-43" 52500.0)
		("BHT-44" 52750.0)
		("BHT-45" 53000.0)
		("BHT-46" 53250.0)
		("BHTCR-47" 53350.0)
		("BHT-48" 53500.0)
		("BHT-49" 53750.0)
		("BHT-50" 54000.0)
		("BHT-51" 54250.0)
		("BHTCR-52" 54500.0)
		("BHT-53" 54750.0)
		("BHT-54" 55000.0)
		("BHT-55" 55250.0)
		("BHT-56" 55500.0)
		("BHT-57" 55750.0)
		("BHT-58" 56000.0)
		("BHT-59" 56250.0)
		("BHT-60" 56500.0)
		("BHT-61" 56750.0)
		("BHT-62" 57000.0)
		("BHT-63" 57250.0)
		("BHT-64" 57500.0)
		("BHT-65" 57750.0)
		("BHTCR-66"	58000.0)
		("BHT-67" 58250.0)
		("BHT-68" 58500.0)
		("BHT-69" 58750.0)
		("BHTCR-70"	59000.0)
		("BHT-71" 59250.0)
		("BHT-72" 59500.0)
		("BHT-73" 59750.0)
		("BHT-74" 60000.0)
		("BHT-75" 60250.0)
		("BHT-76" 60500.0)
		("BHT-77" 60750.0)
		("BHT-78" 61000.0)
		("BHT-79" 61250.0)
		("BHT-80" 61500.0)
		("BHT-81" 61750.0)
		("BHT-82" 62000.0)
		("BHT-83" 62250.0)
		("BHT-84" 62500.0)
		("BHT-85" 62750.0)
		("BHT-86" 63000.0)
		("BHT-87" 63250.0)
		("BHT-88" 63400.0)
	))
	(setq e (car (entsel "\n Select polyline path > " )))
	(cond 
		((and e)
			(setq eo (vlax-ename->vla-object e) i 0 tot (vlax-get eo 'Length))
			(foreach bh boreholes
				(if (< (cadr bh) tot)
					(progn
						(setq p (vlax-curve-getpointatdist eo (cadr bh)))
							(entmake
									(list
									   (cons 0 "CIRCLE")
									   (cons 100 "AcDbCircle")
									   (cons 8 "Boreholes")
									   (cons 10 p)
									   (cons 40 25)
									)   
							)
							(entmake
								(list
								   (cons 0 "TEXT")
								   (cons 100 "AcDbText")
								   (cons 1 (car bh))			   
								   (cons 8 "Boreholes")
								   (cons 10 p)
								   (cons 40 50)
								)   
							)
					)
				)
			)
		)
	)
	(princ)
)

Change boreholes distances list for each particular case.

[CADaSchtroumpf · Accepted solution]

By converting the excel file into a simple text file (CSV: example attached)

Could this do the trick?

(defun add_vtx (obj add_pt ent_name fz / sw ew nw bulg next)
  (vla-GetWidth obj (fix add_pt) 'sw 'ew)
  (vla-addVertex
    obj
    (1+ (fix add_pt))
    (vlax-make-variant
      (vlax-safearray-fill
        (vlax-make-safearray vlax-vbdouble (cons 0 1))
          (list
            (car (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name))
            (cadr (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name))
          )
      )
    )
  )
  (setq next (1+ (fix add_pt)))
  (while (equal (vlax-curve-getdistatparam obj next) (vlax-curve-getdistatparam obj (fix add_pt)) fz)
    (setq next (1+ next))
  )
  (setq
    nw
    (*
      (/
        (- ew sw)
        (- (vlax-curve-getdistatparam obj next) (vlax-curve-getdistatparam obj (fix add_pt)))
      )
      (- (vlax-curve-getdistatparam obj add_pt) (vlax-curve-getdistatparam obj (fix add_pt)))
    )
    bulg (atan (vla-GetBulge obj (fix add_pt)))
  )
  (vla-SetBulge obj
    (fix add_pt)
    (/
      (sin (* 4 bulg (- add_pt (fix add_pt)) 0.25))
      (cos (* 4 bulg (- add_pt (fix add_pt)) 0.25))
    )
  )
  (vla-SetBulge obj
    (1+ (fix add_pt))
    (/
      (sin (* 4 bulg (- (1+ (fix add_pt)) add_pt) 0.25))
      (cos (* 4 bulg (- (1+ (fix add_pt)) add_pt) 0.25))
    )
  )
  (vla-SetWidth obj
    (fix add_pt)
    sw
    (+ nw sw)
  )
  (vla-SetWidth obj
    (1+ (fix add_pt))
    (+ nw sw)
    ew
  )
  (vla-update obj)
)
(vl-load-com)
(defun c:add_vertex_whith_CSV ( / AcDoc js ent vla_obj param_end input f_open l_read len_vtx)
  (setq AcDoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark AcDoc)
  (princ "\nSelect polyline")
  (while (not (setq js (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))))
  (setq
    ent (ssname js 0)
    vla_obj (vlax-ename->vla-object ent)
    param_end (vlax-curve-getEndParam vla_obj)
    input (getfiled "Select a CVS file" "" "csv" 2)
    f_open (open input "r")
  )
  (while (setq l_read (read-line f_open))
    (setq len_vtx (atof l_read))
    (if (not (equal param_end (vlax-curve-getParamAtDist vla_obj len_vtx) 1E-08))
      (add_vtx vla_obj (vlax-curve-getParamAtDist vla_obj len_vtx) ent 1E-08)
    )
  )
  (close f_open)
  (vla-endundomark AcDoc)
  (prin1)
)

[Kent1Cooper]

Since some of the Polyline's segments are arcs, and since adding vertices within them requires calculations of bulge factors for the resulting arc segments on both sides, and since adding them with PEDIT/Edit vertex/Insert option give unwanted results, etc., it seems easier to just Break it with no gap at the locations at all those distances along it, and Join the resulting two pieces after each Break.  AFTER saving the file to .CSV format for reading:

(defun C:APVC ; = Add Polyline Vertices from CSV file
  (/ csv lin dists pts)
  (setvar 'ltgapselection 1)
  (setq
    poly (car (entsel "\nPolyline to add vertices to: "))
    csv (open "C:/Your/File/Path/test_poly.csv" "r") ;; <-- EDIT FILE PATH
  ); setq
  (while (setq lin (read-line csv))
    (if (wcmatch lin "#*"); starts with a number [it's a "data" line]
      (setq dists (cons (atof (substr lin (+ (vl-string-position 44 lin 1 T) 2))) dists))
    ); if
  ); while
  (setq pts (mapcar '(lambda (x) (vlax-curve-getPointAtDist poly (* x 1000))) dists))
  (close csv)
  (foreach pt pts
    (command
      "_.zoom" "_c" pt 100 ;;; [spelling out "_cen" or "_center" is taken as Osnap call]
      "_.break" "_non" pt "@"
      "_.pedit" "_multiple" poly "_last" "" "_join" 0.0 ""
    )
  ); foreach
  (command "_.zoom" "_object" poly "")
  (prin1)
)

Note the need to specify the file path for the file.

It counts on the file being in the form of your example, with all the lines [and only those lines] that contain relevant information all starting with a number, and with the distance part of each line being at the end, following the last comma delimiter.

It can use the usual enhancements, verification that you picked the right kind of thing, a check on whether the Polyline is longer than the greatest distance value, Undo Begin/End wrapping, etc., but see whether it does what you want.

[Sea-Haven]

A excel direct version thanks to Kent for the break method.

;  https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-to-add-vertices-to-polyline/td-p/12114115

(defun C:APVC ; = Add Polyline Vertices from CSV file
  (/ fname lin dists pts myxl getcell oldsnap mybook ll ur cr radd cnt st end lst stxl endxl row polyent pt myrange _csv->lst58 ColumnRow Alpha2Number)
  
(defun getcell (cellname / )
  (setq myRange (vlax-get-property  (vlax-get-property myxl "ActiveSheet") "Range" cellname))
  (princ  (vlax-variant-value (vlax-get-property myRange 'Value2)))
)

; thanks to Lee-mac for this defun 
; www.lee-mac.com
; 44 is comma 9 is tab 34 is space 58 is colon
(defun _csv->lst58 ( str / pos )
	(if (setq pos (vl-string-position 58 str))
		(cons (substr str 1 pos) (_csv->lst58 (substr str (+ pos 2))))
		(list str)
    )
)

; ColumnRow - Returns a list of the Column and Row number
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
;   Cell$ = Cell ID
; Syntax example: (ColumnRow "ABC987") = '(731 987)
;default to "A1" if there's a problem
;-------------------------------------------------------------------------------
(defun ColumnRow (Cell$ / Column$ Char$ Row#)
  (setq Column$ "")
  (while (< 64 (ascii (setq Char$ (strcase (substr Cell$ 1 1)))) 91)
    (setq Column$ (strcat Column$ Char$)
          Cell$ (substr Cell$ 2)
    )
  )
  (if (and (/= Column$ "") (numberp (setq Row# (read Cell$))))
    (list (Alpha2Number Column$) Row#)
    '(1 1)
  )
)
; Alpha2Number - Converts Alpha string into Number
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
;   Str$ = String to convert
; Syntax example: (Alpha2Number "ABC") = 731
;-------------------------------------------------------------------------------
(defun Alpha2Number (Str$ / Num#)
  (if (= 0 (setq Num# (strlen Str$)))
    0
    (+ (* (- (ascii (strcase (substr Str$ 1 1))) 64) (expt 26 (1- Num#)))
       (Alpha2Number (substr Str$ 2))
    )
  )
)
; starts here

(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)

; get and open excel file
  (setq fname (getfiled "Select a Excel File" "c:/" "xl*" 16))

  (or (setq myxl (vlax-get-object "Excel.Application"))
    (setq myxl (vlax-get-or-create-object "excel.Application"))
  )
  (setq myxl (vlax-get-object "Excel.Application"))
  (setq myBook (vl-catch-all-apply 'vla-open (list (vlax-get-property myXL "WorkBooks") fName)))
  (vla-put-visible myXL :vlax-true)
  (vlax-put-property myxl 'ScreenUpdating :vlax-true)
  (vlax-put-property myXL 'DisplayAlerts :vlax-true)
  
; get range of cells
  (setq lst '())
  (setq UR (vlax-get-property  (vlax-get-property myxl "ActiveSheet") "UsedRange"))
  (setq CR (vlax-get-property UR "CurrentRegion"))
  (setq RADD (vlax-get-property CR "Address"))
  (setq cnt (vlax-get-property CR  "Count"))
  (setq lst (_csv->lst58 radd))
  (setq stxl(vl-string-subst "" "$" (vl-string-subst "" "$" (nth 0 lst) )))
  (setq endxl(vl-string-subst "" "$" (vl-string-subst "" "$" (nth 1 lst) )))
  (setq stxl (columnrow st))
  (setq endxl  (columnrow end))

(setq row 3) ; ignores 1st 2 rows in excel and only interested in Column C

;  (setvar 'ltgapselection 1) ; not recognised in Bricscad

(setq polyent (car (entsel "\nPolyline to add vertices to: ")))
(setq poly (vlax-ename->vla-object polyent))

(repeat (- (cadr endxl) 2)
  (setq dists (getcell (strcat "C" (rtos row 2 0))))
  (setq row (1+ row))
  (setq pt (vlax-curve-getPointAtDist poly dists))
  (command "_.zoom" "_c" pt 50)
  (command "_.break" "_non" pt "@")
  (command  "_.pedit" "_multiple" polyent "_last" "" "_join" 0.0 "")
  (princ)
)

(if (not (vlax-object-released-p myRange))(progn(vlax-release-object myRange)(setq myRange nil)))
(if (not (vlax-object-released-p myXL))(progn(vlax-release-object myXL)(setq myXL nil)))

(setvar 'osmode oldsnap)
(princ)
)

(C:APVC)