Jump to content

project polyline to contour line with interpolation each vertex of polyline


reza

Recommended Posts

Hi everyone

Please

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?

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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)))
)

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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 by marko_ribar
code finally updated...
Link to comment
Share on other sites

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

Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...