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:
Entmake a Wipeout in rotated WCS ?
« previous
next »
Print
Pages:
1
[
2
]
All
|
Go Down
Author
Topic: Entmake a Wipeout in rotated WCS ? (Read 10813 times)
0 Members and 1 Guest are viewing this topic.
CAB
Global Moderator
Seagull
Posts: 10401
Re: Entmake a Wipeout in rotated WCS ?
«
Reply #15 on:
February 07, 2013, 12:06:31 PM »
Thought I would share the lisp. Both versions.
This is the Wipeout version.
Code - Auto/Visual Lisp:
[Select]
;; This is a specialised Railing Routine
;; CAB - Jan. 3,2010 to present
;; This version uses Wipeouts
;; Creates an elevation view of 2X Pressure Treated Lumber Hand Rail System
;; Pickets do not touch the deck below
;; Rails are made of 2x4 lumber
;; Rail Cap is made of 2x6 lumber
;; Pickets are made of 2x2 lumber
;; Note: actual lumber sizes are -.5"
(
defun
c:Railing
(
/
a ang b c clr count deflayer dis gap ht m p1 p2 pll rail1 rail2 spc
step tmp whole wid y1 y2 y3 y4 y5
)
(
defun
MkWipeout
(
lst lay
/
c m p
)
(
setq
lst
(
cons
(
last
lst
)
lst
)
p
(
apply
'
mapcar
(
cons
'
min
lst
)
)
m
(
apply
'
max
(
mapcar
'
-
(
apply
'
mapcar
(
cons
'
max
lst
)
)
p
)
)
c
(
mapcar
'
+
p
(
list
(
/
m
2.0
)
(
/
m
2.0
)
)
)
)
(
entmakex
(
append
(
list
'
(
000 .
"WIPEOUT"
)
'
(
100
.
"AcDbEntity"
)
'
(
100
.
"AcDbWipeout"
)
(
cons
8
lay
)
(
cons
10
(
trans
p
1
0
)
)
(
cons
11
(
trans
(
list
m
0.0
)
1
0
)
)
(
cons
12
(
trans
(
list
0.0
m
)
1
0
)
)
'
(
280
.
1
)
'
(
071 .
2
)
)
(
mapcar
(
function
(
lambda
(
x
)
(
cons
14
(
mapcar
'
(
lambda
(
a b c
)
(
/
(
-
a b
)
c
)
)
x c
(
list
m
(
-
m
)
)
)
)
)
)
lst
)
)
)
)
(
defun
up
(
p a d
)
(
polar
p
(
+
a
(
/
pi
2
.
)
)
d
)
)
;; width of pattern 7.5 center of one ballaster to the center of next
;; width of ballaster is 1.5
;; Radius of circle is 3.0
(
setq
defLayer
"zDtl Light 5"
; picket layer
rail1
"zDtl Medium 5"
rail2
"zDtl Medium 4"
wid
1.5
; picket width
ht
37.0
; picket height
spc
3.5
; space between pickets (max < 4.0")
clr
1.625
; picket clearance from deck
y1
3.5
; height of rail lines
y2
7.0
; y1-y2 are botton rail
y3
37.0
; y3-y4 are top rail
y4
40.5
; y4-y5 are rail cap
y5
42.0
)
(
if
(
and
(
setq
p1
(
getpoint
"
\n
Pick lower left."
)
)
(
setq
p2
(
getpoint
"
\n
Pick lower right."
)
)
)
(
progn
(
command
"._undo"
"_begin"
)
(
if
(
<
(
car
p2
)
(
car
p1
)
)
(
setq
tmp p1 p1 p2 p2 tmp
)
)
; make left to right
(
setq
step
(
+
wid spc
)
count
(
/
(
distance
p1 p2
)
step
)
whole
(
1-
(
fix
count
)
)
dis
(
+
wid
(
*
(
+
wid spc
)
whole
)
)
gap
(
/
(
-
(
distance
p1 p2
)
dis
)
2
.
)
ang
(
angle
p1 p2
)
pll
(
polar
(
polar
p1 ang gap
)
(
+
ang
(
/
pi
2
)
)
clr
)
; LowerLeft of 1st picket
)
;; draw rails from bottom up, numbers are the relative Y position
(
MkWipeout
(
list
(
up p1 ang y4
)
(
up p2 ang y4
)
(
up p2 ang y3
)
(
up p1 ang y3
)
)
defLayer
)
(
MkWipeout
(
list
(
up p1 ang y5
)
(
up p2 ang y5
)
(
up p2 ang y4
)
(
up p1 ang y4
)
)
rail1
)
; top of railing
(
MkWipeout
(
list
(
up p1 ang y1
)
(
up p2 ang y1
)
(
up p2 ang y2
)
(
up p1 ang y2
)
)
rail2
)
; bottom
;; Draw pickets
(
repeat
(
1+
whole
)
(
MkWipeout
(
list
pll
(
polar
pll
(
+
ang
(
/
pi
2
)
)
ht
)
(
polar
(
polar
pll
(
+
ang
(
/
pi
2
)
)
ht
)
ang wid
)
(
polar
pll ang wid
)
)
defLayer
)
(
setq
pll
(
polar
pll ang step
)
)
)
(
command
"._undo"
"_end"
)
)
)
(
princ
)
)
Logged
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.
CAB
Global Moderator
Seagull
Posts: 10401
Re: Entmake a Wipeout in rotated WCS ?
«
Reply #16 on:
February 07, 2013, 12:10:03 PM »
This is the Hatch version.
Note that it uses a routine by Lee to correct the draw order of the pline border
The routine can be found here:
http://lee-mac.com/draworderfunctions.html
Code - Auto/Visual Lisp:
[Select]
;; This is a specialised Railing Routine
;; CAB - Jan. 3,2010 to present
;; This version uses Plines & Hatches, previous version used Wipeouts
;; Creates an elevation view of 2X Pressure Treated Lumber Hand Rail System
;; Pickets do not touch the deck below
;; Rails are made of 2x4 lumber
;; Rail Cap is made of 2x6 lumber
;; Pickets are made of 2x2 lumber
;; Note: actual lumber sizes are -.5"
(
defun
c:Railing
(
/
ang clr count deflayer dis gap ht lst norm obj p1 p2 pll spc step tmp
whole wid y1 y2 y3 y4 y5 rail1 rail2 hLayer
)
(
vl-load-com
)
(
defun
mkhatch
(
spc obj lst lay
/
hatch spc
)
(
vl
-
catch
-
all
-
apply
'
(
lambda
(
/
)
(
setq
hatch
(
vla-AddHatch
spc acHatchPatternTypePredefined
"SOLID"
:vlax-true
)
)
(
vlax-invoke
hatch 'AppendOuterLoop
(
list
obj
)
)
(
vla-evaluate
hatch
)
(
vla-put-layer
hatch lay
)
)
)
(
LM:SwapOrder
(
vla-get-activedocument
(
vlax-get-acad-object
)
)
hatch obj
)
;; http://lee-mac.com/draworderfunctions.html
)
;; by CAB 03/22/2009 - modified too close pline
;; Expects pts to be a list of 2D or 3D points
;; Returns new pline object
(
defun
makePline
(
spc pts lay
/
norm elv pline
)
(
setq
norm
(
trans
'
(
0
0
1
)
1
0
T
)
elv
(
caddr
(
trans
(
car
pts
)
1
norm
)
)
)
(
setq
pline
(
vlax-invoke
Spc 'addLightWeightPolyline
(
apply
'
append
(
mapcar
(
function
(
lambda
(
pt
)
(
setq
pt
(
trans
pt
1
norm
)
)
(
list
(
car
pt
)
(
cadr
pt
)
)
)
)
pts
)
)
)
)
(
vla-put-Elevation
pline elv
)
(
vla-put-Normal
pline
(
vlax-3d-point
norm
)
)
(
vla-put-Closed
pline
:vlax-true
)
(
vla-put-Layer
Pline lay
)
pline
)
(
defun
up
(
p a d
)
(
polar
p
(
+
a
(
/
pi
2
.
)
)
d
)
)
;; width of pattern 7.5 center of one picket to the center of next.
;; width of picket is 1.5
(
setq
defLayer
"zDtl Light 5"
; picket layer
rail1
"zDtl Medium 5"
rail2
"zDtl Medium 4"
hLayer
"WipeOut"
wid
1.5
; picket width
ht
37.0
; picket height
spc
3.5
; space between pickets (max < 4.0")
clr
1.625
; picket clearance from deck
y1
3.5
; height of rail lines
y2
7.0
; y1-y2 are botton rail
y3
37.0
; y3-y4 are top rail
y4
40.5
; y4-y5 are rail cap
y5
42.0
)
(
if
(
and
(
setq
p1
(
getpoint
"
\n
Pick lower left."
)
)
(
setq
p2
(
getpoint
"
\n
Pick lower right."
)
)
)
(
progn
(
command
"._undo"
"_begin"
)
(
if
(
<
(
car
p2
)
(
car
p1
)
)
(
setq
tmp p1 p1 p2 p2 tmp
)
)
; make p1-p2 left to right
(
setq
step
(
+
wid spc
)
count
(
/
(
distance
p1 p2
)
step
)
whole
(
1-
(
fix
count
)
)
dis
(
+
wid
(
*
(
+
wid spc
)
whole
)
)
gap
(
/
(
-
(
distance
p1 p2
)
dis
)
2
.
)
ang
(
angle
p1 p2
)
pll
(
polar
(
polar
p1 ang gap
)
(
+
ang
(
/
pi
2
)
)
clr
)
; LowerLeft of 1st picket
)
(
setq
Spc
(
if
(
=
1
(
getvar
"CVPORT"
)
)
(
vla-get-PaperSpace
(
vla-get-activedocument
(
vlax-get-acad-object
)
)
)
(
vla-get-ModelSpace
(
vla-get-activedocument
(
vlax-get-acad-object
)
)
)
)
)
(
setq
lst
(
list
(
up p1 ang y4
)
(
up p2 ang y4
)
(
up p2 ang y3
)
(
up p1 ang y3
)
)
)
(
setq
obj
(
makePline spc lst defLayer
)
)
(
mkhatch spc obj lst hLayer
)
(
setq
lst
(
list
(
up p1 ang y5
)
(
up p2 ang y5
)
(
up p2 ang y4
)
(
up p1 ang y4
)
)
)
(
setq
obj
(
makePline spc lst rail1
)
)
(
mkhatch spc obj lst hLayer
)
(
setq
lst
(
list
(
up p1 ang y1
)
(
up p2 ang y1
)
(
up p2 ang y2
)
(
up p1 ang y2
)
)
)
(
setq
obj
(
makePline spc lst rail2
)
)
(
mkhatch spc obj lst hLayer
)
;; Draw pickets
(
repeat
(
1+
whole
)
(
setq
lst
(
list
pll
(
polar
pll
(
+
ang
(
/
pi
2
)
)
ht
)
(
polar
(
polar
pll
(
+
ang
(
/
pi
2
)
)
ht
)
ang wid
)
(
polar
pll ang wid
)
)
)
(
setq
obj
(
makePline spc lst defLayer
)
)
(
mkhatch spc obj lst hLayer
)
(
setq
pll
(
polar
pll ang step
)
)
)
; end repeat
(
command
"._undo"
"_end"
)
(
command
"._regen"
)
)
)
(
princ
)
)
Logged
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.
VovKa
Water Moccasin
Posts: 1632
Ukraine
Re: Entmake a Wipeout in rotated WCS ?
«
Reply #17 on:
February 07, 2013, 01:08:26 PM »
i would add that hatches must be of (255 255 255) RGB color
Logged
CAB
Global Moderator
Seagull
Posts: 10401
Re: Entmake a Wipeout in rotated WCS ?
«
Reply #18 on:
February 07, 2013, 01:32:36 PM »
Thanks, my LAYER "Wipeout" is set to color 255
Logged
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.
VovKa
Water Moccasin
Posts: 1632
Ukraine
Re: Entmake a Wipeout in rotated WCS ?
«
Reply #19 on:
February 07, 2013, 02:39:48 PM »
Quote from: CAB on February 07, 2013, 01:32:36 PM
Thanks, my LAYER "Wipeout" is set to color 255
have you plotted it already? indexed color 255 will become RGB (250 250 250) when printed out and may turn into gray.
so i suggest using true color (255 255 255) which is 'pure' white
Logged
CAB
Global Moderator
Seagull
Posts: 10401
Re: Entmake a Wipeout in rotated WCS ?
«
Reply #20 on:
February 07, 2013, 02:59:55 PM »
You're quite right and I should have mentioned I use STB method with a
style
called Wipeout also.
The style color is 254 254 254 which is what controls my plotting.
Sorry for the confusion.
Logged
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.
Print
Pages:
1
[
2
]
All
|
Go Up
« previous
next »
TheSwamp
»
Code Red
»
AutoLISP (Vanilla / Visual)
»
Topic:
Entmake a Wipeout in rotated WCS ?