Jump to content

Error in processing multiple vertices


Recommended Posts

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

 

 

image.png.cddba1f325fcf53d87bb9d63a85ff910.png

Link to post
Share on other sites

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

 

 

Link to post
Share on other sites

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")

 

 

 

 

Link to post
Share on other sites

@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))

 

Link to post
Share on other sites

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

×
×
  • Create New...