0 Members and 1 Guest are viewing this topic.
; error: Exception occurred: 0xC0000005 (Access Violation); warning: unwind skipped on unknown exception
(defun vlax-list->2D-point (lst) (if lst (cons (list (car lst) (cadr lst)) (vlax-list->2D-point (cddr lst)))))
(setq miP (apply 'mapcar (cons 'min lst))) (setq maP (apply 'mapcar (cons 'max lst)))
Evgeniy, as Lee've already guessed it is (vlax-put 'Coordinates ...) that issues the error.
By the way, I am not assured, that my result the shortest!
I think so too Mine is messy with all the alterations I've made to it
i think it's time to post your code, Evgeniy.i've tested Lee's a bit, and sometimes it's mistaken.so, seeing your code is essential
Where your variant?
(defun vk_GetPerimeter (CoordsList) (apply '+ (mapcar (function (lambda (p1 p2) (distance p1 p2))) CoordsList (cons (last CoordsList) CoordsList) ) ) ) (defun vk_GetPermutations (lst) (if (cdr lst) (apply 'append (mapcar (function (lambda (e1) (mapcar (function (lambda (e2) (cons e1 e2))) (vk_GetPermutations (vl-remove e1 lst)) ) ) ) lst ) ) (list lst) ) ) (defun mkPoly (lst / mlst mdst dst) (setq lst (vk_GetPermutations lst) mlst (car lst) mdst (vk_GetPerimeter mlst) ) (foreach chain (cdr lst) (if (< (setq dst (vk_GetPerimeter chain)) mdst) (setq mdst dst mlst chain ) ) ) mlst )
(test lst-b) =>> "Polyline Length: 2521.6043 mm."
(defun test (l / D D1 E ENT EP LL LS P) (setq ll (list (apply (function mapcar) (cons (function min) l)) (apply (function mapcar) (cons (function max) l)) ) ;_ append ll (list (car ll) (list (caadr ll) (cadar ll)) (cadr ll) (list (caar ll) (cadadr ll))) ent (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(8 . "temp") '(62 . 1) '(100 . "AcDbPolyline") (cons 90 (length l)) '(70 . 1) ) ;_ list (mapcar (function (lambda (a) (cons 10 a))) ll) ) ;_ append ) ;_ entmakex l (mapcar (function cddr) (vl-sort (mapcar (Function (lambda (a / b) (cons (distance a (setq b (vlax-curve-getClosestPointTo ent a))) (cons (vlax-curve-getParamAtPoint ent b) a) ) ;_ cons ) ;_ lambda ) ;_ Function l ) ;_ mapcar (function (lambda (a b) (if (equal (car a) (car b) 1) (<= (cadr a) (cadr b)) (< (car a) (car b)) ) ;_ if ) ;_ lambda ) ;_ function ) ;_ vl-sort ) ;_ mapcar ls l ) ;_ setq (foreach a ll (setq ls (vl-remove a ls))) (foreach a ls (setq p (vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent a)) p (if (zerop (rem p 1.)) (if (zerop p) (vlax-curve-getEndParam ent) (1- p) ) ;_ if (fix p) ) ;_ if p (vlax-curve-getPointAtParam ent p) p (list 10 (car p) (cadr p)) ) ;_ setq (entmod (append (reverse (member p (reverse (entget ent)))) (list (cons 10 a)) (cdr (member p (entget ent))) ) ;_ append ) ;_ entmod ) ;_ foreach (foreach a l (setq ll (vl-remove a ll))) (entmod (vl-remove-if (function (lambda (a) (member (cdr a) ll))) (entget ent))) (setq l (mapcar (function cdr) (vl-remove-if-not (function (lambda (a) (= (car a) 10))) (entget ent)) ) ;_ mapcar l (mapcar (function list) (cons (last l) l) l) ep (length l) ) ;_ setq (foreach a l (setq e (entget ent) d (vlax-curve-getDistAtParam ent ep) ) ;_ setq (entmod (vl-remove (cons 10 (car a)) (vl-remove (cons 10 (cadr a)) e))) (setq p (vlax-curve-getPointAtParam ent (fix (vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent (car a)))) ) ;_ vlax-curve-getPointAtParam p (list 10 (car p) (cadr p)) ) ;_ setq ;_ setq (entmod (append (reverse (member p (reverse (entget ent)))) (list (cons 10 (car a))) (cdr (member p (entget ent))) ) ;_ append ) ;_ entmod (setq p (vlax-curve-getPointAtParam ent (fix (vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent (cadr a)))) ) ;_ vlax-curve-getPointAtParam p (list 10 (car p) (cadr p)) ) ;_ setq (entmod (append (reverse (member p (reverse (entget ent)))) (list (cons 10 (cadr a))) (cdr (member p (entget ent))) ) ;_ append ) ;_ entmod (if (<= d (setq d1 (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))) (entmod e) (setq d d1 e (entget ent) ) ;_ setq ) ;_ if (entmod (vl-remove (cons 10 (car a)) (vl-remove (cons 10 (cadr a)) e))) (setq p (vlax-curve-getPointAtParam ent (fix (vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent (cadr a)))) ) ;_ vlax-curve-getPointAtParam p (list 10 (car p) (cadr p)) ) ;_ setq (entmod (append (reverse (member p (reverse (entget ent)))) (list (cons 10 (cadr a))) (cdr (member p (entget ent))) ) ;_ append ) ;_ entmod (setq p (vlax-curve-getPointAtParam ent (fix (vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent (car a)))) ) ;_ vlax-curve-getPointAtParam p (list 10 (car p) (cadr p)) ) ;_ setq (entmod (append (reverse (member p (reverse (entget ent)))) (list (cons 10 (car a))) (cdr (member p (entget ent))) ) ;_ append ) ;_ entmod (if (<= d (setq d1 (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))) (entmod e) (setq d d1 e (entget ent) ) ;_ setq ) ;_ if ) ;_ foreach (princ (strcat "\nPolyline Length: " (rtos d 2 4) " mm.")) (princ))
Nice code - works well for lst-b, but you get a freaky result for lst-a I haven't studied your code in depth yet Elpanov, but I shall look at how you changed the points - I think the entmod method is much more reliable than vlax-put...
(test lst-a) =>> "Polyline Length: 3709.0142 mm."
(defun test (l / A B D E LL P PL) (setq p (car l) pl (list p) l (cdr l) ) ;_ setq (while l (setq b (car l) d (distance p (car l)) ) ;_ setq (foreach a l (if (<= (setq e (distance p a)) d) (setq b a d e ) ;_ setq ) ;_ if ) ;_ foreach (setq pl (cons b pl) l (vl-remove b l) p b b (car l) ) ;_ setq ) ;_ while (setq e nil l pl ll l ) ;_ setq (while (and (not e) ll) (setq e t ll l ) ;_ setq (while (and e ll) (setq ll (if (listp (caar ll)) ll (mapcar (function list) (cons (last ll) ll) ll) ) ;_ if a (car ll) pl (vl-remove-if (function (lambda (b) (or (member (car a) b) (member (cadr a) b)))) (cdr ll) ) ;_ vl-remove-if ll (cdr ll) ) ;_ setq (while (and pl (setq b (car pl)) (not (inters (car a) (cadr a) (car b) (cadr b)))) (setq pl (cdr pl)) ) ;_ while (if pl (progn (setq l (append (member (car a) l) (reverse (cdr (member (car a) (reverse l))))) l (append (list (car a)) (member (car b) (reverse (cdr l))) (member (cadr b) l)) e nil ) ;_ setq ) ;_ progn ) ;_ if ) ;_ while ) ;_ while (setq e (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(8 . "temp") '(62 . 1) '(100 . "AcDbPolyline") (cons 90 (length l)) '(70 . 1) ) ;_ list (mapcar (function (lambda (a) (cons 10 a))) l) ) ;_ append ) ;_ entmakex ) ;_ setq (princ (strcat "\nPolyline Length: " (rtos (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)) 2 4) " mm." ) ;_ strcat ) ;_ princ (princ) )
'((34.0417 53.3357) (78.9539 28.539) (45.5878 3.32332) (92.1425 23.3752) (60.589 27.9296) (34.469 8.53055) (97.5564 8.39047) (8.10511 51.1888))
Evgeniy, i have a list for you Code: [Select]'((34.0417 53.3357) (78.9539 28.539) (45.5878 3.32332) (92.1425 23.3752) (60.589 27.9296) (34.469 8.53055) (97.5564 8.39047) (8.10511 51.1888))and i insist that minimum length is 225.88
(defun test (l / D D0 D1 E ENT EP LL LS P) (setq ll (list (apply (function mapcar) (cons (function min) l)) (apply (function mapcar) (cons (function max) l)) ) ;_ append ll (list (car ll) (list (caadr ll) (cadar ll)) (cadr ll) (list (caar ll) (cadadr ll))) ent (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(8 . "temp") '(62 . 1) '(100 . "AcDbPolyline") (cons 90 (length l)) '(70 . 1) ) ;_ list (mapcar (function (lambda (a) (cons 10 a))) ll) ) ;_ append ) ;_ entmakex l (mapcar (function cddr) (vl-sort (mapcar (Function (lambda (a / b) (cons (distance a (setq b (vlax-curve-getClosestPointTo ent a))) (cons (vlax-curve-getParamAtPoint ent b) a) ) ;_ cons ) ;_ lambda ) ;_ Function l ) ;_ mapcar (function (lambda (a b) (if (equal (car a) (car b) 1) (<= (cadr a) (cadr b)) (< (car a) (car b)) ) ;_ if ) ;_ lambda ) ;_ function ) ;_ vl-sort ) ;_ mapcar ls l ) ;_ setq (foreach a ll (setq ls (vl-remove a ls))) (foreach a ls (setq p (vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent a)) p (if (zerop (rem p 1.)) (if (zerop p) (vlax-curve-getEndParam ent) (1- p) ) ;_ if (fix p) ) ;_ if p (vlax-curve-getPointAtParam ent p) p (list 10 (car p) (cadr p)) ) ;_ setq (entmod (append (reverse (member p (reverse (entget ent)))) (list (cons 10 a)) (cdr (member p (entget ent))) ) ;_ append ) ;_ entmod ) ;_ foreach (foreach a l (setq ll (vl-remove a ll))) (entmod (vl-remove-if (function (lambda (a) (member (cdr a) ll))) (entget ent))) (setq l (mapcar (function cdr) (vl-remove-if-not (function (lambda (a) (= (car a) 10))) (entget ent)) ) ;_ mapcar l (mapcar (function list) (cons (last l) l) l) ep (length l) ) ;_ setq (defun f1 (a ent / p) (setq p (vlax-curve-getPointAtParam ent (fix (vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent a))) ) ;_ vlax-curve-getPointAtParam p (list 10 (car p) (cadr p)) ) ;_ setq ;_ setq (entmod (append (reverse (member p (reverse (entget ent)))) (list (cons 10 a)) (cdr (member p (entget ent))) ) ;_ append ) ;_ entmod ) ;_ defun (setq d0 (vlax-curve-getDistAtParam ent ep)) (while (> d0 (progn (foreach a l (setq e (entget ent) d (vlax-curve-getDistAtParam ent ep) ) ;_ setq (entmod (vl-remove (cons 10 (car a)) (vl-remove (cons 10 (cadr a)) e))) (f1 (car a) ent) (f1 (cadr a) ent) (if (<= d (setq d1 (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))) (entmod e) (setq d d1 e (entget ent) ) ;_ setq ) ;_ if (entmod (vl-remove (cons 10 (car a)) (vl-remove (cons 10 (cadr a)) e))) (f1 (cadr a) ent) (f1 (car a) ent) (if (<= d (setq d1 (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))) (entmod e) (setq d d1 e (entget ent) ) ;_ setq ) ;_ if ) ;_ foreach d ) ;_ progn ) ;_ < (setq d0 d) ) ;_ while (princ (strcat "\nPolyline Length: " (rtos d 2 4) " mm.")) (princ))