Welcome,
Guest
. Please
login
or
register
.
1 Hour
1 Day
1 Week
1 Month
Forever
Login with username, password and session length
News:
Home
Help
Login
Register
TheSwamp
»
Code Red
»
AutoLISP (Vanilla / Visual)
»
Topic:
convert 2d polyline to 3d polyline from contours
« previous
next »
Print
Pages: [
1
] |
Go Down
Author
Topic: convert 2d polyline to 3d polyline from contours (Read 3521 times)
0 Members and 1 Guest are viewing this topic.
pedroantonio
Guest
convert 2d polyline to 3d polyline from contours
«
on:
November 22, 2017, 01:01:16 PM »
Hi ,this lisp code convert lines to 3d polylines from contours .I need this code to convert lines and polylines to 3d polylines from contours. Can any one help?
the names of the layers of the contous is
Contour Major Natural Ground color 72
Contour Minor Natural Ground color 23
Code - Auto/Visual Lisp:
[Select]
;Drapes a 3dpolyline over polylines along a selected line.
(
vl-load-com
)
(
defun
c:sample
-
pl
(
/
li
*
ModSpc
*
ActDoc
*
Acad lobj p1 p2 ss sslen i plobj pnts n li pntli finli var
)
(
setq
li
nil
)
(
setq
*
ModSpc
(
vlax-get-property
(
setq
*
ActDoc
(
vlax-get-property
(
setq
*
acad
(
vlax-get-acad-object
)
)
'ActiveDocument
)
)
'ModelSpace
)
)
(
setq
lobj
(
vlax
-
ename
->
vla-object
(
car
(
entsel
"
\n
Select Line Object: "
)
)
)
)
(
setq
p1
(
vlax
-
safearray
->
list
(
vlax
-
variant-value
(
vlax-get-property
lobj 'StartPoint
)
)
)
)
(
setq
p2
(
vlax
-
safearray
->
list
(
vlax
-
variant-value
(
vlax-get-property
lobj 'EndPoint
)
)
)
)
(
setq
ss
(
ssget
"f"
(
list
p1 p2
)
'
(
(
0
.
"LWPOLYLINE"
)
)
)
)
(
setq
sslen
(
sslength
ss
)
)
(
setq
i
0
)
(
repeat
sslen
(
setq
plobj
(
vlax
-
ename
->
vla-object
(
ssname
ss i
)
)
)
(
setq
el
(
vlax-get-property
plobj 'Elevation
)
)
(
vlax-put-property
plobj 'Elevation
0
)
(
setq
pnts
(
vlax-invoke
lobj 'IntersectWith plobj acExtendNone
)
)
(
vlax-put-property
plobj 'Elevation el
)
(
vlax-release-object
plobj
)
(
setq
n
0
)
(
repeat
(
/
(
length
pnts
)
3
)
(
setq
li
(
append
li
(
list
(
nth
(
+
n
0
)
pnts
)
)
)
)
(
setq
li
(
append
li
(
list
(
nth
(
+
n
1
)
pnts
)
)
)
)
(
setq
li
(
append
li
(
list
el
)
)
)
(
drxc
(
list
(
nth
(
+
n
0
)
pnts
)
(
nth
(
+
n
1
)
pnts
)
el
)
2
)
(
setq
n
(
+
n
3
)
)
)
(
setq
i
(
1+
i
)
)
)
(
setq
n
0
)
(
setq
pntli
nil
)
(
repeat
(
/
(
length
li
)
3
)
(
setq
pntli
(
append
pntli
(
list
(
cons
(
distance
(
list
(
nth
(
+
n
0
)
li
)
(
nth
(
+
n
1
)
li
)
)
(
list
(
nth
0
p1
)
(
nth
1
p1
)
)
)
(
list
(
list
(
nth
(
+
n
0
)
li
)
(
nth
(
+
n
1
)
li
)
(
nth
(
+
n
2
)
li
)
)
)
)
)
)
)
(
setq
n
(
+
n
3
)
)
)
(
setq
pntli
(
vl-sort
pntli
(
function
(
lambda
(
d1 d2
)
(
<
(
car
d1
)
(
car
d2
)
)
)
)
)
)
(
setq
n
0
)
(
setq
finli
nil
)
(
repeat
(
length
pntli
)
(
setq
finli
(
append
finli
(
cadr
(
nth
n pntli
)
)
)
)
(
setq
n
(
1+
n
)
)
)
(
setq
var
(
pl
->
var finli
)
)
(
setq
3dobj2
(
vlax-invoke-method
*
ModSpc 'Add3DPoly var
)
)
(
vlax-put-property
3dobj2 'Color
1
)
(
vlax-release-object
3dobj2
)
)
;Given Pointlist returns pointlist in variant form
(
defun
PL
->
VAR
(
pl
/
pl ub sa var
)
(
setq
ub
(
-
(
length
pl
)
1
)
)
(
setq
sa
(
vlax
-
make
-
safearray
vlax-vbdouble
(
cons
0
ub
)
)
)
(
setq
var
(
vlax
-
make
-
variant
(
setq
sa
(
vlax-safearray-fill
sa pl
)
)
)
)
)
;Graphically at given point and color Example (drxc '( 1 2 3) 1) draws x at x=1 y=2 z=3 in the color red
(
defun
drxc
(
ctr color
/
vs xs xs2 cor1 cor2 cor3 cor4 ctr color
)
(
setq
vs
(
getvar
"viewsize"
)
)
(
setq
xs
(
/
vs
20
)
)
(
setq
xs2
(
/
xs
2
)
)
(
setq
cor1
(
polar
ctr
(
*
pi
0.25
)
xs2
)
)
(
setq
cor2
(
polar
ctr
(
*
pi
0.75
)
xs2
)
)
(
setq
cor3
(
polar
ctr
(
*
pi
1.25
)
xs2
)
)
(
setq
cor4
(
polar
ctr
(
*
pi
1.75
)
xs2
)
)
(
grdraw
ctr cor1 color
0
)
(
grdraw
ctr cor2 color
0
)
(
grdraw
ctr cor3 color
0
)
(
grdraw
ctr cor4 color
0
)
)
;The following was written by LEE MAC ~ Cadtutor
;in response to my posting of the above code.
(
defun
c:LWPolySample
(
/
_dxf doc spc lobj p1 ss ev tmp lst
)
(
vl-load-com
)
;; © Lee Mac 2010
(
defun
_dxf
(
code entity
)
(
cdr
(
assoc
code
(
entget
entity
)
)
)
)
(
LM:ActiveSpace 'doc 'spc
)
(
COMMAND
"_layer"
"_m"
"3d section"
"_c"
"55"
""
""
""
)
(
if
(
and
(
setq
lobj
(
car
(
entsel
"
\n
Επιλέξτε μια γραμμή: "
)
)
)
(
eq
"LINE"
(
_dxf
0
lobj
)
)
(
ssget
"_F"
(
list
(
setq
p1
(
_dxf
10
lobj
)
)
(
_dxf
11
lobj
)
)
'
(
(
0
.
"LWPOLYLINE"
)
)
)
)
(
progn
(
setq
lobj
(
vlax
-
ename
->
vla-object
lobj
)
)
(
vlax-for
obj
(
setq
ss
(
vla-get-ActiveSelectionSet
doc
)
)
(
setq
ev
(
vla-get-Elevation
obj
)
)
(
vla-put-Elevation
obj
0.0
)
(
setq
lst
(
cons
(
mapcar
(
function
(
lambda
(
x
)
(
list
(
car
x
)
(
cadr
x
)
ev
)
)
)
(
GroupByNum
(
vlax-invoke
obj 'IntersectWith lobj acExtendNone
)
3
)
)
lst
)
)
(
vla-put-Elevation
obj ev
)
)
(
vla-delete
ss
)
(
vla-put-Color
(
vlax-invoke
spc 'Add3DPoly
(
apply
'
append
(
vl-sort
(
apply
'
append
lst
)
'
(
lambda
(
a b
)
(
<
(
distance
p1
(
list
(
car
a
)
(
cadr
a
)
)
)
(
distance
p1
(
list
(
car
b
)
(
cadr
b
)
)
)
)
)
)
)
)
)
)
)
(
princ
)
)
(
defun
GroupByNum
(
l n
/
r
)
;; © Lee Mac 2010
(
setq
r
(
list
(
car
l
)
)
)
(
if
l
(
cons
(
reverse
(
repeat
(
1-
n
)
(
setq
l
(
cdr
l
)
r
(
cons
(
car
l
)
r
)
)
)
)
(
GroupByNum
(
cdr
l
)
n
)
)
)
)
;;--------------------=={ ActiveSpace }==---------------------;;
;; ;;
;; Retrieves pointers to the Active Document and Space ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2010 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; *doc - quoted symbol (other than *doc) ;;
;; *spc - quoted symbol (other than *spc) ;;
;;------------------------------------------------------------;;
(
defun
LM:ActiveSpace
(
*
doc
*
spc
)
;; © Lee Mac 2010
(
set
*
spc
(
vlax-get-property
(
set
*
doc
(
vla-get-ActiveDocument
(
vlax-get-acad-object
)
)
)
(
if
(
=
1
(
getvar
'CVPORT
)
)
'PaperSpace 'ModelSpace
)
)
)
)
thanks
Logged
ribarm
Gator
Posts: 3307
Marko Ribar, architect
WWW
Re: convert 2d polyline to 3d polyline from contours
«
Reply #1 on:
November 23, 2017, 01:00:48 AM »
http://www.cadtutor.net/forum/showthread.php?100610-longitudinal-profile-from-3D-polyline/page2&p=#12
http://www.cadtutor.net/forum/showthread.php?100571-project-polyline-to-contour-line-with-interpolation-each-vertex-of-polyline&p=#9
Logged
Marko Ribar, d.i.a.
(graduated engineer of architecture)
M.R. on Youtube
pedroantonio
Guest
Re: convert 2d polyline to 3d polyline from contours
«
Reply #2 on:
November 23, 2017, 01:37:29 AM »
thank you
Logged
mailmaverick
Bull Frog
Posts: 495
Re: convert 2d polyline to 3d polyline from contours
«
Reply #3 on:
November 24, 2017, 05:22:52 AM »
Dear Topographer, please let me know what is the use of having a 3D polyline with every vertex at same elevation (Z value) as compared to a 2D Polyline with elevation ?
Logged
pedroantonio
Guest
Re: convert 2d polyline to 3d polyline from contours
«
Reply #4 on:
November 24, 2017, 08:29:40 AM »
i am using it to draw cross sections
Logged
pedroantonio
Guest
Re: convert 2d polyline to 3d polyline from contours
«
Reply #5 on:
November 26, 2017, 05:19:03 AM »
Hi ribarm i use your code and works fine . As i said in the first post the names of the contour layers is
Contour Major Natural Ground
color 72 and
Contour Minor Natural Ground
color 23 , and the contours is
LWPOLYLINE
. Is it possible to understand the contours without need to delect them?
Code - Auto/Visual Lisp:
[Select]
(
defun
c:pl3dpl
;fencelwpoly23dpolyelevations
(
/
*error*
bbucs ucsf osm cec ss1 ss2 i lw pl sss ssl sspl e
)
(
vl-load-com
)
(
defun
*error*
(
msg
)
(
if
ucsf
(
command
"_.UCS"
"_P"
)
)
(
command
"_.ZOOM"
"_P"
)
(
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
"
\n
Select OPEN
\"
STRAIGHT
\"
LWPOLYLINES that lie in plane parallel to WCS - PROJECTION LWPOLYLINES (NOT ELEVATION)..."
)
(
setq
ss1
(
ssget
(
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
"
\n
Empty sel.set... Please reselect again..."
)
(
setq
ss1
(
ssget
(
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
"
\n
Select 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
"
\n
Empty 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
pl
(
mapcar
'
cdr
(
vl
-
remove
-
if
-
not
'
(
lambda
(
x
)
(
=
(
car
x
)
10
)
)
(
entget
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
ssl
(
vl
-
remove
-
if
'
(
lambda
(
x
)
(
eq
(
cadr
x
)
lw
)
)
ssl
)
)
(
setq
sspl
(
mapcar
'
cadr
(
apply
'
append
(
mapcar
'
(
lambda
(
x
)
(
vl
-
remove
-
if
-
not
'
listp
x
)
)
ssl
)
)
)
)
(
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
)
)
)
)
)
)
)
)
)
)
(
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
""
)
)
(
*error*
nil
)
)
Thanks
Logged
pedroantonio
Guest
Re: convert 2d polyline to 3d polyline from contours
«
Reply #6 on:
November 28, 2017, 02:13:21 AM »
Hi ribarm. I did this change in the code but didn't work
Code - Auto/Visual Lisp:
[Select]
;(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>"))))
; )
(
setq
sss
(
ssget
"_F"
pl
(
list
'
(
0
.
"LWPOLYLINE"
)
'
(
-
4
.
"<or"
)
'
(
Contour Major Natural Ground
)
'
(
Contour Minor Natural Ground
)
'
(
-
4
.
"or>"
)
)
)
)
Any ideas . Thanks
Logged
pedroantonio
Guest
Re: convert 2d polyline to 3d polyline from contours
«
Reply #7 on:
November 29, 2017, 11:08:08 AM »
Any ideas?. Thanks
Logged
Print
Pages: [
1
] |
Go Up
« previous
next »
TheSwamp
»
Code Red
»
AutoLISP (Vanilla / Visual)
»
Topic:
convert 2d polyline to 3d polyline from contours