Topic: Entmake a Wipeout in rotated WCS ?

[CAB]

Thought I would share the lisp. Both versions.
This is the Wipeout version.

Code - Auto/Visual Lisp: [Select]

1. ;;  This is a specialised Railing Routine
2. ;;  CAB - Jan. 3,2010 to present
3. ;;  This version uses Wipeouts
4. ;;  Creates an elevation view of  2X Pressure Treated Lumber Hand Rail System
5. ;;  Pickets do not touch the deck below
6. ;;  Rails are made of 2x4 lumber
7. ;;  Rail Cap is made of 2x6 lumber
8. ;;  Pickets are made of 2x2 lumber
9. ;;  Note: actual lumber sizes are -.5"
10. (defun c:Railing(/ a ang b c clr count deflayer dis gap ht m p1 p2 pll rail1 rail2 spc
11.                  step tmp whole wid y1 y2 y3 y4 y5)
12.  
13.  
14.   (defun MkWipeout (lst lay / c m p)
15.     (setq lst (cons (last lst) lst)
16.           p (apply 'mapcar (cons 'min lst))
17.           m (apply 'max (mapcar '- (apply 'mapcar (cons 'max lst)) p))
18.           c (mapcar '+ p (list (/ m 2.0) (/ m 2.0)))
19.     )
20.     (entmakex
21.       (append
22.         (list
23.           '(000 . "WIPEOUT")
24.           '(100 . "AcDbEntity")
25.           '(100 . "AcDbWipeout")
26.           (cons 8 lay)
27.           (cons 10 (trans p 1 0))
28.           (cons 11 (trans (list m 0.0) 1 0))
29.           (cons 12 (trans (list 0.0 m) 1 0))
30.           '(280 . 1)
31.           '(071 . 2)
32.         )
33.         (mapcar
34.           (function
35.             (lambda (x)
36.               (cons 14 (mapcar '(lambda (a b c) (/ (- a b) c)) x c (list m (- m)))))) lst)))
37.    )
38.  
39.   (defun up (p a d)
40.     (polar p (+ a (/ pi 2.)) d)
41.   )
42.  
43.  
44.   ;;  width of pattern 7.5 center of one ballaster to the center of next
45.   ;;  width of ballaster is 1.5
46.   ;;  Radius of circle is 3.0
47.   (setq defLayer "zDtl Light 5"  ; picket layer
48.         rail1    "zDtl Medium 5"
49.         rail2    "zDtl Medium 4"
50.         wid  1.5   ; picket width
51.         ht   37.0  ; picket height
52.         spc  3.5   ; space between pickets (max < 4.0")
53.         clr  1.625 ; picket clearance from deck
54.         y1   3.5   ; height of rail lines
55.         y2   7.0   ; y1-y2 are botton rail
56.         y3   37.0  ; y3-y4 are top rail
57.         y4   40.5  ; y4-y5 are rail cap
58.         y5   42.0
59.   )
60.   (if (and
61.          (setq p1 (getpoint "\nPick lower left."))
62.          (setq p2 (getpoint "\nPick lower right."))
63.       )
64.     (progn
65.       (command "._undo" "_begin")
66.       (if (< (car p2)(car p1)) (setq tmp p1 p1 p2 p2 tmp)) ; make left to right
67.      
68.       (setq step  (+ wid spc)
69.             count (/ (distance p1 p2) step)
70.             whole (1- (fix count))
71.             dis   (+ wid (* (+ wid spc) whole))
72.             gap   (/ (- (distance p1 p2) dis) 2.)
73.             ang   (angle p1 p2)
74.             pll   (polar (polar p1 ang gap) (+ ang (/ pi 2)) clr)  ; LowerLeft of 1st picket
75.       )
76.       ;;  draw rails from bottom up, numbers are the relative Y position
77.       (MkWipeout (list(up p1 ang y4)(up p2 ang y4)(up p2 ang y3)(up p1 ang y3)) defLayer)
78.       (MkWipeout (list(up p1 ang y5)(up p2 ang y5)(up p2 ang y4)(up p1 ang y4)) rail1) ; top of railing
79.       (MkWipeout (list(up p1 ang y1)(up p2 ang y1)(up p2 ang y2)(up p1 ang y2)) rail2) ; bottom
80.      
81.       ;; Draw pickets
82.       (repeat (1+ whole)
83.         (MkWipeout (list
84.                        pll                                            
85.                       (polar pll (+ ang (/ pi 2)) ht)                
86.                       (polar (polar pll (+ ang (/ pi 2)) ht) ang wid)
87.                       (polar pll ang wid)                            
88.                     ) defLayer)
89.         (setq pll (polar pll ang step))
90.        )
91.  
92.       (command "._undo" "_end")
93.     )
94.   )
95.   (princ)
96. )

[CAB]

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]

1. ;;  This is a specialised Railing Routine
2. ;;  CAB - Jan. 3,2010 to present
3. ;;  This version uses Plines & Hatches, previous version used Wipeouts
4. ;;  Creates an elevation view of 2X Pressure Treated Lumber Hand Rail System
5. ;;  Pickets do not touch the deck below
6. ;;  Rails are made of 2x4 lumber
7. ;;  Rail Cap is made of 2x6 lumber
8. ;;  Pickets are made of 2x2 lumber
9. ;;  Note: actual lumber sizes are -.5"
10. (defun c:Railing(/ ang clr count deflayer dis gap ht lst norm obj p1 p2 pll spc step tmp
11.                  whole wid y1 y2 y3 y4 y5 rail1 rail2 hLayer)
12.   (vl-load-com)
13.  
14.   (defun mkhatch (spc obj lst lay / hatch spc)
15.         (vl-catch-all-apply
16.           '(lambda (/)
17.              (setq hatch (vla-AddHatch spc acHatchPatternTypePredefined "SOLID" :vlax-true))
18.              (vlax-invoke hatch 'AppendOuterLoop (list obj))
19.              (vla-evaluate hatch)
20.              (vla-put-layer hatch lay)
21.            )
22.        )
23.     (LM:SwapOrder (vla-get-activedocument (vlax-get-acad-object)) hatch obj)
24.     ;;  http://lee-mac.com/draworderfunctions.html
25.   )
26.  
27.  
28.   ;;  by CAB 03/22/2009 - modified too close pline
29.   ;;  Expects pts to be a list of 2D or 3D points
30.   ;;  Returns new pline object
31.   (defun makePline (spc pts lay / norm elv pline)
32.     (setq norm  (trans '(0 0 1) 1 0 T)
33.           elv   (caddr (trans (car pts) 1 norm))
34.     )
35.     (setq pline
36.       (vlax-invoke Spc 'addLightWeightPolyline
37.         (apply 'append
38.           (mapcar  (function (lambda (pt)
39.              (setq pt (trans pt 1 norm))
40.              (list (car pt) (cadr pt))))
41.             pts)))
42.     )
43.     (vla-put-Elevation pline elv)
44.     (vla-put-Normal pline (vlax-3d-point norm))
45.     (vla-put-Closed pline :vlax-true)
46.     (vla-put-Layer Pline lay)
47.     pline
48.   )
49.  
50.   (defun up (p a d) (polar p (+ a (/ pi 2.)) d))
51.  
52.  
53.   ;;  width of pattern 7.5 center of one picket to the center of next.
54.   ;;  width of picket is 1.5
55.   (setq defLayer "zDtl Light 5"  ; picket layer
56.         rail1    "zDtl Medium 5"
57.         rail2    "zDtl Medium 4"
58.         hLayer   "WipeOut"
59.         wid  1.5   ; picket width
60.         ht   37.0  ; picket height
61.         spc  3.5   ; space between pickets (max < 4.0")
62.         clr  1.625 ; picket clearance from deck
63.         y1   3.5   ; height of rail lines
64.         y2   7.0   ; y1-y2 are botton rail
65.         y3   37.0  ; y3-y4 are top rail
66.         y4   40.5  ; y4-y5 are rail cap
67.         y5   42.0
68.   )
69.   (if (and
70.          (setq p1 (getpoint "\nPick lower left."))
71.          (setq p2 (getpoint "\nPick lower right."))
72.       )
73.     (progn
74.       (command "._undo" "_begin")
75.       (if (< (car p2)(car p1)) (setq tmp p1 p1 p2 p2 tmp)) ; make p1-p2 left to right
76.      
77.       (setq step  (+ wid spc)
78.             count (/ (distance p1 p2) step)
79.             whole (1- (fix count))
80.             dis   (+ wid (* (+ wid spc) whole))
81.             gap   (/ (- (distance p1 p2) dis) 2.)
82.             ang   (angle p1 p2)
83.             pll   (polar (polar p1 ang gap) (+ ang (/ pi 2)) clr)  ; LowerLeft of 1st picket
84.       )
85.  
86.       (setq Spc
87.             (if (= 1 (getvar "CVPORT"))
88.               (vla-get-PaperSpace (vla-get-activedocument (vlax-get-acad-object)))
89.               (vla-get-ModelSpace (vla-get-activedocument (vlax-get-acad-object)))
90.             )
91.       )
92.      
93.       (setq lst (list(up p1 ang y4)(up p2 ang y4)(up p2 ang y3)(up p1 ang y3)))
94.       (setq obj (makePline spc lst defLayer))
95.       (mkhatch spc obj lst hLayer)
96.       (setq lst (list(up p1 ang y5)(up p2 ang y5)(up p2 ang y4)(up p1 ang y4)))
97.       (setq obj (makePline spc lst rail1))
98.       (mkhatch spc obj lst hLayer)
99.       (setq lst (list(up p1 ang y1)(up p2 ang y1)(up p2 ang y2)(up p1 ang y2)))
100.       (setq obj (makePline spc lst rail2))
101.       (mkhatch spc obj lst hLayer)
102.  
103.       ;; Draw pickets
104.       (repeat (1+ whole)
105.         (setq lst (list
106.                      pll                                            
107.                     (polar pll (+ ang (/ pi 2)) ht)                
108.                     (polar (polar pll (+ ang (/ pi 2)) ht) ang wid)
109.                     (polar pll ang wid)                            
110.                     ))
111.         (setq obj (makePline spc lst defLayer))
112.         (mkhatch spc obj lst hLayer)
113.         (setq pll (polar pll ang step))
114.       ) ; end repeat
115.      
116.       (command "._undo" "_end")
117.       (command "._regen")
118.     )
119.   )
120.   (princ)
121. )
122.  

[VovKa]

i would add that hatches must be of (255 255 255) RGB color

[CAB]

Thanks, my LAYER "Wipeout" is set to color 255

[VovKa]

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

[CAB]

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.