Anushka Posted November 25, 2021 Share Posted November 25, 2021 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) ) Quote Link to comment Share on other sites More sharing options...
mhupp Posted November 25, 2021 Share Posted November 25, 2021 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)) Quote Link to comment Share on other sites More sharing options...
BIGAL Posted November 25, 2021 Share Posted November 25, 2021 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") Quote Link to comment Share on other sites More sharing options...
Anushka Posted November 25, 2021 Author Share Posted November 25, 2021 @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)) Quote Link to comment Share on other sites More sharing options...
mhupp Posted November 26, 2021 Share Posted November 26, 2021 looks like they have updated it. https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/get-vertices/td-p/10766795 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.