ghostware Posted September 9, 2011 Posted September 9, 2011 Hi, i've searched for a while, but cannot find out how to: Pick two points running across your 3D Topo (3D Polylines) and the above will create a 3D Polyline with vertices at the elevations (Z) of the crossed 3D Polylines. sorry for my bad english (i speak dutch) Many thanks Pascal 3D polyline Sample.dwg Quote
David Bethel Posted September 9, 2011 Posted September 9, 2011 Pascal, That could be a very intense project. Questions: are the yellow line always a 2 point 3DPOLYline? are the yellow lines always parallel? is the intersecting line always a 2 point vector Just for a few for starters -David Quote
Snownut Posted September 9, 2011 Posted September 9, 2011 (edited) Thats not as difficult as one would think. Lee Mac (thanks Lee) has a function on his website that list all of the Vertex's of the crossing points, all you would need to add is a while statement that would draw a polyline to each vertex. I just completed a similar routine that uses this information to create a Cross-Section from starting point to ending point of the line drawn. See movie here to see application. https://sites.google.com/site/septicassistantnh/screen-shot-videos/infiltrator-eda-design Edited September 9, 2011 by Snownut Add additional info Quote
ghostware Posted September 9, 2011 Author Posted September 9, 2011 David, are the yellow line always a 2 point 3DPOLYline? No are the yellow lines always parallel? No is the intersecting line always a 2 point vector Yes Quote
Lee Mac Posted September 10, 2011 Posted September 10, 2011 An example for LWPolylines: http://www.cadtutor.net/forum/showthread.php?62153-data-from-contour&p=423779&viewfull=1#post423779 Quote
David Bethel Posted September 10, 2011 Posted September 10, 2011 Thats not as difficult as one would think. Lee Mac (thanks Lee) has a function on his website I don't think that Lee's solution should be considered as elementary ...... In fact it is very complex My $0.02 -David Quote
David Bethel Posted September 10, 2011 Posted September 10, 2011 An example for LWPolylines: http://www.cadtutor.net/forum/showthread.php?62153-data-from-contour&p=423779&viewfull=1#post423779 Lee, I couldn't get it to work in 2012 (changed (0 . "LWPOLYLINE") to '(0 . "POLYLINE) It didn't like the 'elevation' statement Does the intersetwith return a list of multiple points ? -David Quote
Lee Mac Posted September 10, 2011 Posted September 10, 2011 I couldn't get it to work in 2012 (changed (0 . "LWPOLYLINE") to '(0 . "POLYLINE) It didn't like the 'elevation' statement David, That posted solution will only work for LWPolylines since only LWPolylines have an Elevation Property [equiv. DXF 38], Polylines with varying elevation along their length will be far more complex. Does the intersetwith return a list of multiple points ? Yes, the IntersectWith method returns multiple points in the form of a SafeArray Variant of Doubles, but when used with vlax-invoke, this Variant is automatically converted to a list of Doubles. Quote
David Bethel Posted September 10, 2011 Posted September 10, 2011 In plain Autolisp: (defun c:slice3dp (/ p1 p2 vl ss en ed vn vd vl il sl tp zp al md d2d i) (defun FindZOnLine (fp p1 p2) (defun 2d (p) (list (car p) (cadr p))) (cond ((equal (append (2d fp) (list (nth 2 p1))) p1 1e-11) (nth 2 p1)) ((equal (append (2d fp) (list (nth 2 p2))) p2 1e-11) (nth 2 p2)) ((not (and (equal (angle p1 p2) (angle p1 (2d fp)) 1e-11) (equal (angle p2 p1) (angle p2 (2d fp)) 1e-11)))) ((zerop (distance p1 p2)) (nth 2 p1)) ((and (equal (car p1) (car p2) 1e-11) (equal (cadr p1) (cadr p2) 1e-11))) ((equal (nth 2 p1) (nth 2 p2) 1e-11) (nth 2 p1)) (T (+ (nth 2 p1) (* (- (nth 2 p2) (nth 2 p1)) (/ (distance (list (car p1) (cadr p1)) (list (car (2d fp)) (cadr (2d fp)))) (distance (list (car p1) (cadr p1)) (list (car p2) (cadr p2))))))))) (defun remove (expr lst);;;TonyT or VNesterowski (apply 'append (subst nil (list expr) (mapcar 'list lst)))) (initget 1) (setq p1 (getpoint "\n1st Point: ")) (setq p1 (list (car p1) (cadr p1))) (initget 1) (setq p2 (getpoint p1 "\n2nd Point: ")) (setq p2 (list (car p2) (cadr p2))) (grdraw p1 p2 2 1) (princ "\nReading 3DPOLY Data...\n") (and (setq ss (ssget "_F" (list p1 p2))) (while (setq en (ssname ss 0)) (princ "\r") (prin1 en) (redraw en 3) (setq ed (entget en)) (if (and (= (cdr (assoc 0 ed)) "POLYLINE") (= (logand (cdr (assoc 70 ed)) 8)) (progn (setq vn (entnext en) vd (entget vn) vl nil) (while (= "VERTEX" (cdr (assoc 0 vd))) (and (/= (logand (cdr (assoc 70 vd)) 16) 16) (= (logand (cdr (assoc 70 vd)) 32) 32) (setq vl (cons (cdr (assoc 10 vd)) vl))) (setq vn (entnext vn) vd (entget vn))) (setq i 0) (repeat (1- (length vl)) (setq sl (cons (list (nth i vl) (nth (1+ i) vl)) sl) i (1+ i))) (if (= (logand (cdr (assoc 70 ed)) 1) 1) (setq sl (cons (list (car vl) (last vl)) sl))))) (ssdel en ss))) (foreach s sl (if (setq tp (inters p1 p2 (list (car (car s)) (cadr (car s))) (list (car (cadr s)) (cadr (cadr s))))) (setq zp (FindZOnLine tp (car s) (cadr s)) il (cons (list (car tp) (cadr tp) zp) il)))) (while (> (length il) 0) (setq md 0) (foreach pt il (setq d2d (distance (list (car p1) (cadr p1)) (list (car pt) (cadr pt)))) (if (> d2d md) (setq md d2d tp pt))) (setq al (cons tp al) il (remove tp il))) (command "_.3DPOLY") (foreach v al (command v)) (command "") (prin1)) I'm sure some of this could be condensed. -David Quote
Lee Mac Posted September 11, 2011 Posted September 11, 2011 Haven't tested as yet, but after a cursory glance, looks good David Quote
ghostware Posted September 11, 2011 Author Posted September 11, 2011 David , It works perfect. You did a great job and thanks. It will save me a lot of time with this task that I have to do. thx for your time. Quote
ghostware Posted September 11, 2011 Author Posted September 11, 2011 David, I only add osmode to disable snapping while drawing the 3Dpoly. [color=red](setvar "osmode" 0)[/color] (command "_.3DPOLY")(foreach v al(command v))(command "")[code] Quote
Tharwat Posted September 11, 2011 Posted September 11, 2011 Another way ....... (defun c:Test (/ p1 p2 ss e i a v1 v2 ps) (vl-load-com) ;;;;;;;;; Tharwat 11. 09. 2011 ;;;;;;;;;;; (if (and (setq p1 (getpoint "\n First points :")) (setq p2 (getpoint p1 "\n Second Point :")) (setq ss (ssget "_f" (list p1 p2))) ) (progn (setq e (entmakex (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))) (repeat (setq i (sslength ss)) (if (not (member (cdr (assoc 0 (entget (setq a (ssname ss (setq i (1- i)))))) ) '("LWPOLYLINE" "POLYLINE") ) ) (ssdel a ss) (progn (setq v1 (vlax-ename->vla-object a) v2 (vlax-ename->vla-object e) ) (setq ps (cons (vlax-invoke v1 'IntersectWith v2 0) ps)) ) ) ) (if (> (length ps) 1) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length ps)) (cons 70 1) ) (mapcar (function (lambda (p) (cons 10 p))) ps) ) ) ) (entdel e) ) (princ) ) (princ) ) Tharwat Quote
Lee Mac Posted September 11, 2011 Posted September 11, 2011 (edited) Having had a proper look, I must say, great code David, I really like your method: clean and intuitive to follow. I hope you don't mind, I have made some modifications to condense the code and perhaps improve performance: (defun c:Slice3DPoly ( / _FindZOnLine ed en i p1 p2 pl sl ss tp vd vl ) ;; A modification by Lee Mac of the code by David Bethel found here: ;; http://www.cadtutor.net/forum/showthread.php?62556-3D-polyline-Intersection&p=426585&viewfull=1#post426585 (defun _FindZOnLine ( fp p1 p2 ) (cond ( (or (equal p1 p2 1e-11) (equal (caddr p1) (caddr p2) 1e-11) (equal (list (car p1) (cadr p1)) (list (car p2) (cadr p2)) 1e-11) ) (caddr p1) ) ( (+ (caddr p1) (* (- (caddr p2) (caddr p1)) (/ (distance (list (car p1) (cadr p1)) (list (car fp) (cadr fp))) (distance (list (car p1) (cadr p1)) (list (car p2) (cadr p2))) ) ) ) ) ) ) (if (and (setq p1 (getpoint "\nSpecify First Point: ")) (setq p2 (getpoint "\nSpecify Second Point: " p1)) (setq ss (ssget "_F" (list p1 p2) '((0 . "POLYLINE") (-4 . "<NOT") (-4 . "&") (70 . 118) (-4 . "NOT>")))) ) (progn (repeat (setq i (sslength ss)) (setq en (ssname ss (setq i (1- i))) ed (entget en) en (entnext en) vd (entget en) vl nil ) (while (eq "VERTEX" (cdr (assoc 0 vd))) (setq vl (cons (cdr (assoc 10 vd)) vl) en (entnext en) vd (entget en) ) ) (if (= 1 (logand 1 (cdr (assoc 70 ed)))) (setq sl (cons (mapcar 'list vl (append (cdr vl) (list (car vl)))) sl)) (setq sl (cons (mapcar 'list vl (cdr vl)) sl)) ) ) (foreach s (apply 'append sl) (if (setq tp (inters p1 p2 (list (caar s) (cadar s)) (list (caadr s) (cadadr s)) ) ) (setq pl (cons (list (car tp) (cadr tp) (_FindZOnLine tp (car s) (cadr s))) pl)) ) ) (entmakex '((0 . "POLYLINE") (10 0.0 0.0 0.0) (70 . 8))) (foreach x (vl-sort pl (function (lambda ( a b ) (< (distance p1 (list (car a) (cadr a))) (distance p1 (list (car b) (cadr b))) ) ) ) ) (entmakex (list '(0 . "VERTEX") (cons 10 x) '(70 . 32))) ) (entmakex '((0 . "SEQEND"))) ) ) (princ) ) (vl-load-com) (princ) Edited November 19, 2020 by Lee Mac 1 Quote
Lee Mac Posted September 11, 2011 Posted September 11, 2011 Another way ....... Tharwat, I don't think you have understood the task - it is impossible that the result could be an LWPolyline since the elevation will need to vary along the length of the contour. Try your code on the drawing provided by the OP. Result using David's code: Result using Tharwat's code: Command: test First points : Second Point :; error: bad DXF group: (10) Quote
Tharwat Posted September 11, 2011 Posted September 11, 2011 That's right , I have not used to deal with 3dpoly that much , and that's why I considered it as a normal Polyline and which of course would not work as expected in that case , and only in 2d model only. I apologize for that mistake . Quote
ghostware Posted September 11, 2011 Author Posted September 11, 2011 Thanks Lee I've had a play around with it and it works great. Quote
Lee Mac Posted September 11, 2011 Posted September 11, 2011 Thanks Lee I've had a play around with it and it works great. Good stuff ghostware - but all credit to David of course Quote
David Bethel Posted September 11, 2011 Posted September 11, 2011 @Lee, Thanks, I figured that I had the right concept, just didn't put in the full time to develop it fully. My FindZOnLine was probably 20 years old. I couldn't get any filters to work with (ssget "F") originally. Must of had a typo. ( The R13 manual says doesn't list them so I gathered that they were not available ) I think that '(-4 . "&=") '(70 . would be all that is needed for this one. I can't think of a instance where the 8 bit is set other than a 3DPOLY I don't have vl-sort. That's one I need to see if I can port into plain autolisp fairly simply 1 day. Most (sort...) routines that I've seen in plain autolisp are very complex. @Ghostware, Glad it worked for you This probably needs a full program with a robust *error* trap and sysvar mode settings. Anytime that a new entity is made, things like CECOLOR CLAYER come into play. Same thing with OSNAPs when using (command ). Lee's use of (entmake) can handle most of these, it does take a good bit more coding than even what he has posted now. Quote
Lee Mac Posted September 11, 2011 Posted September 11, 2011 I think that [noparse]'(-4 . "&=") '(70 . [/noparse] would be all that is needed for this one. I can't think of a instance where the 8 bit is set other than a 3DPOLY But [noparse](-4 . "&") (70 . [/noparse] would not exclude 3D Polylines with Spline/Curve fit vertices, for which the linear 'FindZOnLine' would fail. I don't have vl-sort. That's one I need to see if I can port into plain autolisp fairly simply 1 day. Most (sort...) routines that I've seen in plain autolisp are very complex. (vl-sort) is very convenient (and pretty quick too); I remember gile wrote a nice equivalent here which uses only Vanilla AutoLISP. This probably needs a full program with a robust *error* trap and sysvar mode settings. Anytime that a new entity is made, things like CECOLOR CLAYER come into play. Lee's use of (entmake) can handle most of these, it does take a good bit more coding than even what he has posted now. I would think the *error* handler would only be required to suppress a function cancelled message should the user hit Esc, or close any Undo marks. After all, we are not changing any System Variables and nothing need be reset. I don't think the values of CECOLOR/CLAYER/THICKNESS etc. come into play here, since (entmake) will use the current values for these as default, this would be expected behaviour. Quote
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.