Error in processing multiple vertices

[Anushka]

A friend in the neighboring community developed this program that works well, but when I try to process in a polyline with multiple verticies it doesn't process. Can someone help me find out why ?? I've already tried debugging but I have little knowledge.

 

(defun c:dim_poly_segment_angles ( / 
	LM:intersections take take2 pick_poly adoc e plo coords 
	cir co intlist pt p1 p2 p3 arcent ao side
	)
	;Author:  hak_vz 
	;Friday, November 19, 2021 
	;https://forums.autodesk.com/t5/user/viewprofilepage/user-id/5530556
	;Posted at 
	;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/get-vertices/td-p/10766795
	;Creates angular dimensions between polyline segments
	(defun *error* ( msg )
		(if (not (member msg '("Function cancelled" "quit / exit abort")))
			(princ)
		)
		(if (and adoc) (vla-endundomark adoc))
		(setvar 'cmdecho 0)
		(princ)
	)
	(defun LM:intersections ( ob1 ob2 mod / lst rtn )
		(if (and (vlax-method-applicable-p ob1 'intersectwith)
				 (vlax-method-applicable-p ob2 'intersectwith)
				 (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
			)
			(repeat (/ (length lst) 3)
				(setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
					  lst (cdddr lst)
				)
			)
		)
		(reverse rtn)
	)
	(defun take (amount lst / ret)(repeat amount (setq ret (cons (car lst) (take (1- amount) (cdr lst))))))
	(defun take2 (lst) (take 2 lst))
	(defun pointlist2d (lst / ret) (while lst (setq	ret (cons (take 2 lst) ret) lst (cddr lst))) (reverse ret))
	(defun pick_poly ( / e eo)
		(setq e (car(entsel "\n\nSelect polyline >")))
		(cond 
			((and (not e) (= (getvar 'Errno) 7))
			(princ "\nNothing selected. Try again!")
			(pick_poly))
			((and e (not (= (vla-get-ObjectName (vlax-ename->vla-object e)) "AcDbPolyline")))
			  (princ "\nSelected entity is not a polyline!")
			  (pick_poly)
			)
			((and e (= (vla-get-ObjectName (vlax-ename->vla-object e)) "AcDbPolyline"))
				e
			)
		)
	)
(setq adoc (vla-get-ActiveDocument (vlax-get-acad-object)) blocks (vla-get-blocks adoc))
(setq e (pick_poly) plo (vlax-ename->vla-object e))
(setq coords (pointlist2d(vlax-get plo 'Coordinates)))
(if (= (vlax-get plo 'Closed) 0)
	(setq coords (cdr(take (1- (length coords))coords)))
	(setq coords (append coords (list (cadr coords))))
)
(if (null radius)(setq radius (getreal "\nEnter arc dimension internal radius > ")))
(if (null radius)(setq radius 50))
(initget "L R")
(setq side(getkword "\nSelect side left or right <L R> >> ")) 				
(vla-endundomark adoc)
(vla-startundomark adoc)	
(setvar 'cmdecho 0)
(foreach pt coords
	(setq cir(entmakex (list (cons 0 "CIRCLE") (cons 10 pt) (cons 40 radius))))
	(setq co (vlax-ename->vla-object cir))
	(setq intlist (mapcar 'take2 (LM:intersections co plo acextendboth)))
	(mapcar 'set '(p1 p2) (vl-sort intlist '(lambda (x y) (> (vlax-curve-getdistatpoint plo x)(vlax-curve-getdistatpoint plo y)))))
	(command "_.arc" "c" pt p1 p2)
	(setq arcent (entlast) ao (vlax-ename->vla-object arcent))
    (setq p3 (vlax-curve-getpointatdist ao(* 0.5(vlax-get ao 'ArcLength))))
	(if (= side "R")(setq p3 (polar p3 (angle P3 PT)(* 2.0 radius))))
	(vlax-release-object co)
	(vlax-release-object ao)
	(entdel cir)
	(entdel arcent)
	(command "_.dimangular" "" "_none" pt "_none" p1 "_none" p2 "_none" p3)
)
(vla-endundomark adoc)
(setvar 'cmdecho 1)
(princ "\Done!")
(princ)
)

 

 

[mhupp]

With just a quick look. might have something to do with the pointlist2d or take2 functions?

 

(setq coords (pointlist2d(vlax-get plo 'Coordinates)))

(setq coords (vlax-get plo 'Coordinates))

 

 

[BIGAL]

Like mhupp copy this to command line and select your pline, have a look  let us know what object is.

 

(entget (car (entsel "\npick pline ")))

 

eg normal pline ((-1 . <Entity name: 6c8107a0>) (0 . "LWPOLYLINE") (100 . "AcDbPolyline") 

 

This is 3d polyline ((-1 . <Entity name: 6c813560>) (0 . "POLYLINE")  (100 . "AcDb3dPolyline")

 

 

 

 

[Anushka]

@BIGAL
 

((-1 . <Entity name: 1a245dc0b70>) (0 . "LWPOLYLINE") (330 . <Entity name: 1a26dba01f0>) (5 . "B977") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "teste") (62 . 4) (100 . "AcDbPolyline") (90 . 24) (70 . 0) (43 . 0.0) (38 . 0.0) (39 . 0.0) (10 558719.0 9.33134e+06) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 558747.0 9.3314e+06) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 558806.0 9.33139e+06) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 558834.0 9.33144e+06) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 558907.0 9.33144e+06) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 558993.0 9.3315e+06) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 559038.0 9.33156e+06) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 559088.0 9.33162e+06) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 559180.0 9.33162e+06) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 559225.0 9.33167e+06) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 559327.0 9.33171e+06) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 559237.0 9.33177e+06) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 559105.0 9.33177e+06) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 558889.0 9.33175e+06) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 558693.0 9.33174e+06) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 558670.0 9.33166e+06) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 558537.0 9.33166e+06) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 558522.0 9.33175e+06) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 558450.0 9.33176e+06) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 558566.0 9.33182e+06) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 558548.0 9.33196e+06) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 558388.0 9.33195e+06) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 558401.0 9.33202e+06) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 558547.0 9.33205e+06) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (210 0.0 0.0 1.0))

 

[mhupp]

looks like they have updated it.

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/get-vertices/td-p/10766795