reza Posted May 1, 2017 Share Posted May 1, 2017 Hi everyone Please if possible to solve the problem in the attachments guide me project.dwg Quote Link to comment Share on other sites More sharing options...
tombu Posted May 1, 2017 Share Posted May 1, 2017 Hi everyonePlease if possible to solve the problem in the attachments guide me The contour polylines on layer MCURVE are at an interval of 2.5. What problem are you trying to solve? Quote Link to comment Share on other sites More sharing options...
reza Posted May 1, 2017 Author Share Posted May 1, 2017 thank you for reply I'd like to project pline in layer "2222" on contour lines in layer "MCURVE" at intersection point between pline and contour lines and if there will be vertex of polyline between contour lines then interpolate them for find Z value and at the end of draw 3dpolyline Quote Link to comment Share on other sites More sharing options...
reza Posted May 1, 2017 Author Share Posted May 1, 2017 I'm sorry to use meaningless names in attachment lisp I'm not a professional I try whit attachment lisp App Intersection Curve.lsp Project.dwg Quote Link to comment Share on other sites More sharing options...
Grrr Posted May 2, 2017 Share Posted May 2, 2017 Use ssget "_CP" with intersectwith method. Quote Link to comment Share on other sites More sharing options...
BIGAL Posted May 2, 2017 Share Posted May 2, 2017 A simple trick to work out the inters point as your alignment is at 0.0 and pline at 475.0 make a selection set of plines take 1 pline get z set your alignment to that z then a simple defun this is a manual version. (setq obj1 (vlax-ename->vla-object (car (entsel "\nPick 1st object")))) (while (setq obj2 (vlax-ename->vla-object (car (entsel "\nPick 2nd object")))) (setq elv (vla-get-elevation obj2)) (vla-put-elevation obj1 elv) (setq pt (vlax-invoke obj1 'intersectWith obj2 acExtendNone)) (alert (strcat "X=" (rtos (car pt) 2 2) "\nY=" (rtos (cadr pt) 2 2) "\nZ=" (rtos elv 2 2))) ) Quote Link to comment Share on other sites More sharing options...
reza Posted May 2, 2017 Author Share Posted May 2, 2017 hi dear bigal : if you open my drawing and lisp file , You will notice that I'm going to draw a 3dpolyline on the alignment with "Z" of contour lines in "MCURVE" layer I can get "Z" value in intersection of alignment and contour line , but I can't get "Z" value when vertex of alignment between curves we use project object to surface in the land and civil3d , I'm going to do something like that Of course, without the use of surface , but with the use of contour lines and interpolation for all vertex of my alignment thank you Quote Link to comment Share on other sites More sharing options...
tombu Posted May 2, 2017 Share Posted May 2, 2017 Why not create a surface from the contour lines then project object to the contour surface? Quote Link to comment Share on other sites More sharing options...
marko_ribar Posted May 2, 2017 Share Posted May 2, 2017 (edited) Not 100% sure, but you can try this : (defun c:flw23pel-new ;fencelwpoly23dpolyelevations ( / *error* bbucs ucsf osm cec ss1 ss2 i lw pl sss ssl sspl e sss1 ssl1 sspl1 ppl1 z1 ppl2 pll par 3dpl lws ) (vl-load-com) (defun *error* ( msg ) (if ucsf (command "_.UCS" "_P") ) (command "_.ZOOM" "_P") (foreach e 3dpl (if (vlax-erased-p e) (entdel e) ) ) (foreach e lws (if (vlax-erased-p e) (entdel e) ) ) (if osm (setvar 'osmode osm) ) (if cec (setvar 'cecolor cec) ) (if msg (prompt msg) ) (princ) ) (defun bbucs ( ss / UCS2WCSMatrix WCS2UCSMatrix n ent minpt maxpt minptlst maxptlst minptbbx minptbby minptbbz minptbb maxptbbx maxptbby maxptbbz maxptbb ) (vl-load-com) ;; Doug C. Broad, Jr. ;; can be used with vla-transformby to ;; transform objects from the UCS to the WCS (defun UCS2WCSMatrix () (vlax-tmatrix (append (mapcar '(lambda (vector origin) (append (trans vector 1 0 t) (list origin)) ) (list '(1 0 0) '(0 1 0) '(0 0 1)) (trans '(0 0 0) 0 1) ) (list '(0 0 0 1)) ) ) ) ;; transform objects from the WCS to the UCS (defun WCS2UCSMatrix () (vlax-tmatrix (append (mapcar '(lambda (vector origin) (append (trans vector 0 1 t) (list origin)) ) (list '(1 0 0) '(0 1 0) '(0 0 1)) (trans '(0 0 0) 1 0) ) (list '(0 0 0 1)) ) ) ) (if ss (progn (repeat (setq n (sslength ss)) (setq ent (ssname ss (setq n (1- n)))) (vla-TransformBy (vlax-ename->vla-object ent) (UCS2WCSMatrix)) (vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint) (vla-TransformBy (vlax-ename->vla-object ent) (WCS2UCSMatrix)) (setq minpt (vlax-safearray->list minpoint)) (setq maxpt (vlax-safearray->list maxpoint)) (setq minptlst (cons minpt minptlst)) (setq maxptlst (cons maxpt maxptlst)) ) (setq minptbbx (caar (vl-sort minptlst '(lambda (a b) (< (car a) (car b)))))) (setq minptbby (cadar (vl-sort minptlst '(lambda (a b) (< (cadr a) (cadr b)))))) (setq minptbbz (caddar (vl-sort minptlst '(lambda (a b) (< (caddr a) (caddr b)))))) (setq maxptbbx (caar (vl-sort maxptlst '(lambda (a b) (> (car a) (car b)))))) (setq maxptbby (cadar (vl-sort maxptlst '(lambda (a b) (> (cadr a) (cadr b)))))) (setq maxptbbz (caddar (vl-sort maxptlst '(lambda (a b) (> (caddr a) (caddr b)))))) (setq minptbb (list minptbbx minptbby minptbbz)) (setq maxptbb (list maxptbbx maxptbby maxptbbz)) ) ) (list minptbb maxptbb) ) (if (= 0 (getvar 'worlducs)) (progn (command "_.UCS" "_W") (command "_.PLAN" "") (setq ucsf t) ) (command "_.PLAN" "") ) (setq osm (getvar 'osmode)) (setvar 'osmode 0) (setq cec (getvar 'cecolor)) (setvar 'cecolor "3") (prompt "\nSelect OPEN \"STRAIGHT\" LWPOLYLINES that lie in plane parallel to WCS - PROJECTION LWPOLYLINES (NOT ELEVATION)...") (setq ss1 (ssget "_:L" (list '(0 . "LWPOLYLINE") '(-4 . "<or") '(70 . 0) '(70 . 128) '(-4 . "or>") '(-4 . "<or") '(210 0.0 0.0 1.0) '(210 0.0 0.0 -1.0) '(-4 . "or>") '(-4 . "<not") '(-4 . "<>") '(42 . 0.0) '(-4 . "not>")))) (while (or (not ss1) (vl-every '(lambda ( x ) (not (equal (caddar (bbucs (ssadd x))) (caddr (cadr (bbucs (ssadd x)))) 1e-6))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1)))) ) (prompt "\nEmpty sel.set... Please reselect again...") (setq ss1 (ssget "_:L" (list '(0 . "LWPOLYLINE") '(-4 . "<or") '(70 . 0) '(70 . 128) '(-4 . "or>") '(-4 . "<or") '(210 0.0 0.0 1.0) '(210 0.0 0.0 -1.0) '(-4 . "or>") '(-4 . "<not") '(-4 . "<>") '(42 . 0.0) '(-4 . "not>")))) ) (prompt "\nSelect LWPOLYLINES that lie in plane parallel to WCS - ELEVATION LWPOLYLINES (NOT PROJECTION)...") (setq ss2 (ssget (list '(0 . "LWPOLYLINE") '(-4 . "<or") '(210 0.0 0.0 1.0) '(210 0.0 0.0 -1.0) '(-4 . "or>")))) (while (not ss2) (prompt "\nEmpty sel.set... Please reselect again...") (setq ss2 (ssget (list '(0 . "LWPOLYLINE") '(-4 . "<or") '(210 0.0 0.0 1.0) '(210 0.0 0.0 -1.0) '(-4 . "or>")))) ) (repeat (setq i (sslength ss1)) (setq lw (ssname ss1 (setq i (1- i)))) (setq lws (cons lw lws)) (entdel lw) ) (foreach lw lws (entdel lw) (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget lw)))) (entdel lw) (setq sss (ssget "_F" pl (list '(0 . "LWPOLYLINE") '(-4 . "<or") '(210 0.0 0.0 1.0) '(210 0.0 0.0 -1.0) '(-4 . "or>")))) (setq ssl (ssnamex sss)) (setq sspl (mapcar 'cadr (apply 'append (mapcar '(lambda ( x ) (vl-remove-if-not 'listp x)) ssl)))) (entdel lw) (setq sspl (vl-sort sspl '(lambda ( a b ) (< (vlax-curve-getparamatpoint lw (vlax-curve-getclosestpointto lw (list (car a) (cadr a) (cdr (assoc 38 (entget lw)))))) (vlax-curve-getparamatpoint lw (vlax-curve-getclosestpointto lw (list (car b) (cadr b) (cdr (assoc 38 (entget lw)))))))))) (entdel lw) (setq sss1 (ssget "_F" (list (car pl) (mapcar '+ (car sspl) (mapcar '* (mapcar '- (car pl) (car sspl)) (list 1e+3 1e+3)))) (list '(0 . "LWPOLYLINE") '(-4 . "<or") '(210 0.0 0.0 1.0) '(210 0.0 0.0 -1.0) '(-4 . "or>")))) (if sss1 (progn (setq ssl1 (ssnamex sss1)) (setq sspl1 (mapcar 'cadr (apply 'append (mapcar '(lambda ( x ) (vl-remove-if-not 'listp x)) ssl1)))) (setq sspl1 (vl-sort sspl1 '(lambda ( a b ) (< (distance (car pl) a) (distance (car pl) b))))) (setq ppl1 (car sspl1)) (setq ppl1 (mapcar '+ '(0 0) ppl1)) (if ppl1 (setq z1 (+ (cdr (assoc 38 (entget (ssname (ssget "_C" ppl1 ppl1) 0)))) (* (- (cdr (assoc 38 (entget (ssname (ssget "_C" (car sspl) (car sspl)) 0)))) (cdr (assoc 38 (entget (ssname (ssget "_C" ppl1 ppl1) 0))))) (/ (distance (car sspl) (car pl)) (distance (car sspl) (mapcar '+ '(0 0) ppl1)))))) (setq z1 0.0) ) (setq pll (cons (list (caar pl) (cadar pl) z1) pll)) ) ) (foreach p (cdr pl) (entdel lw) (setq par (vlax-curve-getparamatpoint lw (list (car p) (cadr p) (cdr (assoc 38 (entget lw)))))) (setq ppl1 (last (vl-remove-if '(lambda ( x ) (minusp (- par (vlax-curve-getparamatpoint lw (vlax-curve-getclosestpointto lw (list (car x) (cadr x) (cdr (assoc 38 (entget lw))))))))) sspl))) (entdel lw) (setq ppl1 (mapcar '+ '(0 0) ppl1)) (if (and ppl1 (not (equal ppl1 (last pl) 1e-6))) (progn (setq sss1 (ssget "_F" (list ppl1 (mapcar '+ ppl1 (mapcar '* (mapcar '- p ppl1) (list 1e+3 1e+3)))) (list '(0 . "LWPOLYLINE") '(-4 . "<or") '(210 0.0 0.0 1.0) '(210 0.0 0.0 -1.0) '(-4 . "or>")))) (setq ssl1 (ssnamex sss1)) (setq sspl1 (mapcar 'cadr (apply 'append (mapcar '(lambda ( x ) (vl-remove-if-not 'listp x)) ssl1)))) (setq sspl1 (vl-sort sspl1 '(lambda ( a b ) (< (distance (mapcar '+ '(0 0) ppl1) a) (distance (mapcar '+ '(0 0) ppl1) b))))) (setq ppl2 (cadr sspl1)) (setq ppl2 (mapcar '+ '(0 0) ppl2)) (if ppl2 (setq z1 (+ (cdr (assoc 38 (entget (ssname (ssget "_C" ppl1 ppl1) 0)))) (* (- (cdr (assoc 38 (entget (ssname (ssget "_C" ppl2 ppl2) 0)))) (cdr (assoc 38 (entget (ssname (ssget "_C" ppl1 ppl1) 0))))) (/ (distance ppl1 p) (distance (mapcar '+ '(0 0) ppl1) ppl2))))) (setq z1 0.0) ) (setq pll (cons (list (car p) (cadr p) z1) pll)) ) ) ) (entdel lw) (setq sspl (vl-sort (append sspl pll) '(lambda ( a b ) (< (vlax-curve-getparamatpoint lw (vlax-curve-getclosestpointto lw (list (car a) (cadr a) (cdr (assoc 38 (entget lw)))))) (vlax-curve-getparamatpoint lw (vlax-curve-getclosestpointto lw (list (car b) (cadr b) (cdr (assoc 38 (entget lw)))))))))) (entdel lw) (setq pll nil) (command "_.3DPOLY") (foreach p sspl (if (vl-some '(lambda ( x ) (if (vlax-curve-getparamatpoint x (list (car p) (cadr p) (cdr (assoc 38 (entget x))))) (setq e x))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2)))) (command "_non" (list (car p) (cadr p) (cdr (assoc 38 (entget e))))) (command "_non" p) ) ) (command "") (setq 3dpl (cons (entlast) 3dpl)) (entdel (entlast)) ) (*error* nil) ) Edited May 3, 2017 by marko_ribar code finally updated... Quote Link to comment Share on other sites More sharing options...
reza Posted May 2, 2017 Author Share Posted May 2, 2017 HIP HIP HOORA HI GREAT Marko These were the times that you help me to get I thank you big guy and I thank all of 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.