marko_ribar Posted October 31, 2017 Share Posted October 31, 2017 This is old topic, still I've run into this and I wanted to correct the code by Lee Mac... This : (setq foo (if (< (distance (vlax-curve-getStartPoint e1) (vlax-curve-getStartPoint e2)) (distance (vlax-curve-getStartPoint e1) (vlax-curve-getEndPoint e2))) (lambda ( x ) (x)) (lambda ( x ) (- l2 x)) ) ) When you analyze closer all input things should be : (setq foo (if (< (distance (vlax-curve-getStartPoint e1) (vlax-curve-getStartPoint e2)) (distance (vlax-curve-getStartPoint e1) (vlax-curve-getEndPoint e2))) (lambda ( x ) (* x (/ l2 len))) (lambda ( x ) (- l2 (* x (/ l2 len)))) ) ) Else as I see is fine... M.R. Quote Link to comment Share on other sites More sharing options...
marko_ribar Posted October 31, 2017 Share Posted October 31, 2017 Also (LM:Polyline ptlst) should be like this (3d polyline) : (defun LM:Polyline ( lst ) ;; © Lee Mac ~ 23.06.10 (entmake (list (cons 0 "POLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDb3dPolyline") (cons 10 '(0 0 0)) (cons 70 )) (mapcar '(lambda ( x ) (entmake (list (cons 0 "VERTEX") (cons 100 "AcDbEntity") (cons 100 "AcDbVertex") (cons 100 "AcDb3dPolylineVertex") (cons 10 x) (cons 70 32)) ) ) lst ) (entmake (list (cons 0 "SEQEND") (cons 100 "AcDbEntity"))) ) Quote Link to comment Share on other sites More sharing options...
Least Posted December 12, 2017 Share Posted December 12, 2017 A good improvement Marko. Thanks Quote Link to comment Share on other sites More sharing options...
roy437 Posted May 30, 2020 Share Posted May 30, 2020 Hi, Here is another version of the rolling ball by the bisection method. Part of the code is from Lee-Mac, thank you. The code does not work for any curves and in the case presented in jpg you must first select the upper curve then the lower one (line). ; Mid of the two curves, method rolling ball ; Part of the code is from Lee-Mac (thank you) ; 2020-05-28 = Roy437 = (vl-load-com) (defun c:mc ( / *error* a b c d1 d2 dis ds ent1 ent2 eps len_ent1 p1 p2 pp sel tmp ) (setvar 'CMDECHO 0) (setvar 'OSMODE 0) (setq eps 0.0001) (command "color" 3) (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\nError: " msg)) ) (princ) ) (if (not (and (setq ds (getenv "LMac\\dist")) (setq ds (atof ds)) (< 0 ds) ) ) (setenv "LMac\\dist" (rtos (setq ds 1.0))) ) (if (setq sel (ssget "_:L" '( (0 . "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE") (-4 . "<NOT") (-4 . "<AND") (0 . "POLYLINE") (-4 . "&") (70 . 88) (-4 . "AND>") (-4 . "NOT>") ) ) ) (progn (initget 4) (if (setq tmp (getreal (strcat "\nSpecify length of arc(ds) <" (rtos ds) ">: "))) (setenv "LMac\\dist" (rtos (setq ds tmp))) ) (LM:startundo (LM:acdoc)) (setq ent1 (ssname sel 0) ent2 (ssname sel 1) dis 0.0 len_ent1 (vlax-curve-getdistatparam ent1 (vlax-curve-getendparam ent1)) ) (command "pline") (while (< dis len_ent1) (if (setq p1 (vlax-curve-getpointatdist ent1 dis)) (progn (setq p2 (vlax-curve-getClosestPointTo ent2 p1) a p2 b p1 d1 0.0 d2 1.0 ) ; Bisection method ; --------------------------------------------------------------------- (while (> (abs (- d2 d1)) eps) (setq c (midp a b) pp (vlax-curve-getClosestPointTo ent1 c) d1 (distance c pp) d2 (distance c p2) ) (if (< d1 d2) (setq b c) (setq a c) ) ) ; --------------------------------------------------------------------- (command c) ) ) (setq dis (+ dis ds)) ) (command) (LM:endundo (LM:acdoc)) ) ) (princ) ) ;; Start Undo - Lee Mac ;; Opens an Undo Group. (defun LM:startundo ( doc ) (LM:endundo doc) (vla-startundomark doc) ) ;; End Undo - Lee Mac ;; Closes an Undo Group. (defun LM:endundo ( doc ) (while (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark doc) ) ) ;; Active Document - Lee Mac ;; Returns the VLA Active Document Object (defun LM:acdoc nil (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) (LM:acdoc) ) ;; Midpoint - Lee Mac ;; Returns the midpoint of two points (defun midp ( a b ) (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b) ) (princ "\nMC") (princ) I'm waiting for comments. 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.