Topic: Drawing polyline from the block

[antistar]

Hi to all,
I ask a great help to teachers.
I have a block with 4 tags for length, thickness, elevation and width.
Could anyone help me write a routine to capture the data from these tags and draw the closed polyline + 2 internal lines, parallel to the block?
It would be possible to change the dimensions of the drawing whenever I change a tag?

Block Name: ID_DATA
Tags: LEN, THI, ELE and WID.

Thanks in advance.

[Lee Mac]

The creation of the Polyline based on the block attribute information could certainly be achieved, (this function will help you in that respect); however, the automatic updating of the Polyline dimensions based on the attribute information would be rather complicated, likely requiring the use of reactors.

[antistar]

The creation of the Polyline based on the block attribute information could certainly be achieved, (this function will help you in that respect); however, the automatic updating of the Polyline dimensions based on the attribute information would be rather complicated, likely requiring the use of reactors.

Ok Lee,
 Thank you for your attention and explanation.
 I understand the complexity of using reactors. The reactors will leave to another step.
 Could you help me create a polyline with the attribute information?

[Lee Mac]

Could you help me create a polyline with the attribute information?

Post the code that you have started and I'll offer hints and tips 

[antistar]

Could you help me create a polyline with the attribute information?

Post the code that you have started and I'll offer hints and tips 

Applying his subroutine LM: GetAttributes, I got the following list:

 ((LEN. 140) (THI. 120) (ELE. 100) (WID. 14))

[CAB]

Looks like a window opening.
Why not create a dynamic block and the reactors are built in.

[antistar]

Looks like a window opening.
Why not create a dynamic block and the reactors are built in.

CAB,
 It is just a window opening. I'm accepting any suggestions.
 Thanks.

[CAB]

Wish I had time, but not today.
Maybe one of the user who know there way around dynamic blocks would help.


I'll move the thread to CAD forum to see if anyone will jump in.

[antistar]

Wish I had time, but not today.
Maybe one of the user who know there way around dynamic blocks would help.


I'll move the thread to CAD forum to see if anyone will jump in.

CAB,
 Thank you for your attention.
 Something as suggested, will help me a lot.

[ribarm]

I have the routine to make window opening but not as block, but as 3d solids geometry... I used to use this code frequently when I have to model house with windows openings... Only thing is that you have to follow steps exactly explained while executing routine and just to mention your walls if are 3d solids - they have to have openings already subtracted from wall solids... These windows are always "rectangular" viewed in elevation view of facade...

Code: [Select]

(defun c:3d-w ( / -A -AA -AAA -B -BP -DDHP -DDV -DH -DV -H -Z A A1 A2 A3 A4 AA AA1 AA2 AA3 AA4 AAA B B1 B2 B3 B4 BP D DDH DDHP DDV DDVP DH DV H H1 HPR NH NV O OH OSCMD OV PAUSE PT1 PT1AA PT1U PT1UU PT1UUU PT2 PT2AA PT2U PT2UU PT2UUU PT3 PT3AA PT3U PT3UU PT3UUU PT4 PT4AA PT4U PT4UU PT4UUU PT5 PTSU PTSUU PTUUEH PTUUENDH PTUUENDV PTUUEV PTX PTY SPL1 SPL2 SPLA1 SPLA2 SPLU1 SPLU2 SSPL1 SSPL2 SSPLA1 SSPLA2 SSPLU1 SSPLU2 STAK V V1 VPR Z )
(setq oscmd (getvar "osmode"))
(setvar "osmode" 35)
(arxload "geomcal.arx")
(prompt "\nMODELING 3D WINDOW OR DOOR OR FILLING OPENING WITH BARS - ENTER TO CONTINUE")
(print)
(textscr)
(command pause)
(command "ucs" "w")
(setq pt1 (getpoint "\nPick first point of outer edge of wall opening - lower left : "))
(setq pt2 (getpoint "\nPick second point of outer edge of wall opening - lower right : "))
(setq pt3 (getpoint "\nPick third point of outer edge of wall opening - upper right : "))
(setq pt4 (getpoint "\nPick fourth point of outer edge of wall opening - upper left : "))
(setq d (getdist pt1 "\nUnesite debljinu prozora : "))
(setq a 0.0)
(while (eq a 0.0) (setq a (getdist "\nInput thickness of outer frame of window - <must be more than 0 - 2 points> : ")))
(setq b (getdist "\nInput thickness of inner frame of window - <0=no inner frame and no glass solid box - 2 points> : "))
(setq z (getdist "\nInput gap from outer edge of opening to inner frame of window - <0=plane of outer edge - 2 points> : "))
(setq nv (getreal "\nNumber of vertical bars - <ENTER - 0> : "))
(setq nh (getreal "\nNumber of horizontal bars - <ENTER - 0> : "))
(setq aa (getdist "\nInput width of outer frame around opening - <ENTER - 0> : "))
(if (eq aa nil) (setq aa 0))
(if (eq aa 0) (setq aaa 0)
(setq aaa (getdist "\nInput thickness of outer frame around opening - frontal extrusion in front of opening - < 2 points > : "))
)
(if (/= nv nil) (setq ddv (getreal "\nDimensions of vertical bars - d/d , d= : ")) (setq ddv 0.0))
(if (/= nh nil) (setq ddh (getreal "\nDimensions of horizontal bars - d/d , d= : ")) (setq ddh 0.0))
(setvar "osmode" 0)
(command "ucs" "3p" pt1 pt2 pt3)
(setq o '(0 0 0))
(setvar "osmode" 35)
(setq pt5 (getpoint o "\nInput normal vector of UCS - inside point of opening in wall : "))
(command "ucs" "za" o pt5)
(setvar "osmode" 0)
(setq pt1u (trans pt1 0 1))
(setq pt2u (trans pt2 0 1))
(setq pt3u (trans pt3 0 1))
(setq pt4u (trans pt4 0 1))
(command "pline" pt1u pt2u pt3u pt4u "c")
(setq spl1 (ssadd))
(ssadd (entlast) spl1)
(setq ptsu (cal "(pt1u+pt2u+pt3u+pt4u)/4"))
(command "offset" a spl1 ptsu "")
(setq spl2 (ssadd))
(ssadd (entlast) spl2)
(command "extrude" spl1 "" d "")
(setq sspl1 (ssadd))
(ssadd (entlast) sspl1)
(command "extrude" spl2 "" d "")
(setq sspl2 (ssadd))
(ssadd (entlast) sspl2)
(command "subtract" sspl1 "" sspl2 "" "")
(setq -a (- 0 a))
(setq -z (- 0 z))
(setq a1 (list -a a z))
(setq pt1uu (cal "pt1u+a1"))
(setq a2 (list a a z))
(setq pt2uu (cal "pt2u+a2"))
(setq a3 (list a -a z))
(setq pt3uu (cal "pt3u+a3"))
(setq a4 (list -a -a z))
(setq pt4uu (cal "pt4u+a4"))

(if (eq b 0) ()
(progn
(command "pline" pt1uu pt2uu pt3uu pt4uu "c")
(setq splu1 (ssadd))
(ssadd (entlast) splu1)
(setq ptsuu (cal "(pt1uu+pt2uu+pt3uu+pt4uu)/4"))
(command "offset" b splu1 ptsuu "")
(setq splu2 (ssadd))
(ssadd (entlast) splu2)
(command "extrude" splu1 "" b "")
(setq ssplu1 (ssadd))
(ssadd (entlast) ssplu1)
(command "extrude" splu2 "" b "")
(setq ssplu2 (ssadd))
(ssadd (entlast) ssplu2)
(command "subtract" ssplu1 "" ssplu2 "" "")
(setq -b (- 0 b))
(setq bp (/ b 2))
(setq -bp (- 0 bp))
(setq b1 (list -b b bp))
(setq pt1uuu (cal "pt1uu+b1"))
(setq b2 (list b b bp))
(setq pt2uuu (cal "pt2uu+b2"))
(setq b3 (list b -b bp))
(setq pt3uuu (cal "pt3uu+b3"))
(setq b4 (list -b -b bp))
(setq pt4uuu (cal "pt4uu+b4"))
(command "pline" pt1uuu pt2uuu pt3uuu pt4uuu "c")
(setq stak (ssadd))
(ssadd (entlast) stak)
(command "extrude" stak "" bp "")
))

(if (/= nv nil)
(progn
(setq v (distance pt1uu pt4uu))
(setq dv (/ v (+ nh 1)))
(setq -dv (- 0 dv))
(setq ov (list 0 dv 0))
(setq -ddv (- 0 ddv))
(setq ddvp (/ ddv 2))
(setq ptuuev (list -ddv v 0))
(setq ptuuendv (cal "pt1uu+ptuuev"))
(command "rectangle" pt1uu ptuuendv "")
(setq vpr (ssadd))
(ssadd (entlast) vpr)
(command "extrude" vpr "" ddv "")
(setq v1 (ssadd))
(ssadd (entlast) v1)
(setq ptx (list ddvp 0 0))
(command "move" v1 "" o ptx)
(repeat (fix nv)
(command "copy" (entlast) "" o oh)
)
(command "erase" v1 "")
))

(if (/= nh nil)
(progn
(setq h (distance pt1uu pt2uu))
(setq dh (/ h (+ nv 1)))
(setq -dh (- 0 dh))
(setq oh (list -dh 0 0))
(setq -h (- 0 h))
(setq ddhp (/ ddh 2))
(setq -ddhp (- 0 ddhp))
(setq ptuueh (list -h ddh 0))
(setq ptuuendh (cal "pt1uu+ptuueh"))
(command "rectangle" pt1uu ptuuendh "")
(setq hpr (ssadd))
(ssadd (entlast) hpr)
(command "extrude" hpr "" ddh "")
(setq h1 (ssadd))
(ssadd (entlast) h1)
(setq pty (list 0 -ddhp 0))
(command "move" h1 "" o pty)
(repeat (fix nh)
(command "copy" (entlast) "" o ov)
)
(command "erase" h1 "")
))

(if (and (eq aa 0) (eq aaa 0)) ()
(progn
(setq -aa (- 0 aa))
(setq aa1 (list aa -aa 0))
(setq pt1aa (cal "pt1u+aa1"))
(setq aa2 (list -aa -aa 0))
(setq pt2aa (cal "pt2u+aa2"))
(setq aa3 (list -aa aa 0))
(setq pt3aa (cal "pt3u+aa3"))
(setq aa4 (list aa aa 0))
(setq pt4aa (cal "pt4u+aa4"))
(setq -aaa (- 0 aaa))
(command "pline" pt1aa pt2aa pt3aa pt4aa "c")
(setq spla1 (ssadd))
(ssadd (entlast) spla1)
(command "offset" aa spla1 ptsu "")
(setq spla2 (ssadd))
(ssadd (entlast) spla2)
(command "extrude" spla1 "" -aaa "")
(setq sspla1 (ssadd))
(ssadd (entlast) sspla1)
(command "extrude" spla2 "" -aaa "")
(setq sspla2 (ssadd))
(ssadd (entlast) sspla2)
(command "subtract" sspla1 "" sspla2 "" "")
))

(command "ucs" "w")
(setvar "osmode" oscmd)

(princ)
)

Hope this helps... To me it helped lots of times...
Marko Ribar, d.i.a. (architect)
 

[antistar]

I have the routine to make window opening but not as block, but as 3d solids geometry... I used to use this code frequently when I have to model house with windows openings... Only thing is that you have to follow steps exactly explained while executing routine and just to mention your walls if are 3d solids - they have to have openings already subtracted from wall solids... These windows are always "rectangular" viewed in elevation view of facade...

Code: [Select]

(defun c:3d-w ( / -A -AA -AAA -B -BP -DDHP -DDV -DH -DV -H -Z A A1 A2 A3 A4 AA AA1 AA2 AA3 AA4 AAA B B1 B2 B3 B4 BP D DDH DDHP DDV DDVP DH DV H H1 HPR NH NV O OH OSCMD OV PAUSE PT1 PT1AA PT1U PT1UU PT1UUU PT2 PT2AA PT2U PT2UU PT2UUU PT3 PT3AA PT3U PT3UU PT3UUU PT4 PT4AA PT4U PT4UU PT4UUU PT5 PTSU PTSUU PTUUEH PTUUENDH PTUUENDV PTUUEV PTX PTY SPL1 SPL2 SPLA1 SPLA2 SPLU1 SPLU2 SSPL1 SSPL2 SSPLA1 SSPLA2 SSPLU1 SSPLU2 STAK V V1 VPR Z )
(setq oscmd (getvar "osmode"))
(setvar "osmode" 35)
(arxload "geomcal.arx")
(prompt "\nMODELING 3D WINDOW OR DOOR OR FILLING OPENING WITH BARS - ENTER TO CONTINUE")
(print)
(textscr)
(command pause)
(command "ucs" "w")
(setq pt1 (getpoint "\nPick first point of outer edge of wall opening - lower left : "))
(setq pt2 (getpoint "\nPick second point of outer edge of wall opening - lower right : "))
(setq pt3 (getpoint "\nPick third point of outer edge of wall opening - upper right : "))
(setq pt4 (getpoint "\nPick fourth point of outer edge of wall opening - upper left : "))
(setq d (getdist pt1 "\nUnesite debljinu prozora : "))
(setq a 0.0)
(while (eq a 0.0) (setq a (getdist "\nInput thickness of outer frame of window - <must be more than 0 - 2 points> : ")))
(setq b (getdist "\nInput thickness of inner frame of window - <0=no inner frame and no glass solid box - 2 points> : "))
(setq z (getdist "\nInput gap from outer edge of opening to inner frame of window - <0=plane of outer edge - 2 points> : "))
(setq nv (getreal "\nNumber of vertical bars - <ENTER - 0> : "))
(setq nh (getreal "\nNumber of horizontal bars - <ENTER - 0> : "))
(setq aa (getdist "\nInput width of outer frame around opening - <ENTER - 0> : "))
(if (eq aa nil) (setq aa 0))
(if (eq aa 0) (setq aaa 0)
(setq aaa (getdist "\nInput thickness of outer frame around opening - frontal extrusion in front of opening - < 2 points > : "))
)
(if (/= nv nil) (setq ddv (getreal "\nDimensions of vertical bars - d/d , d= : ")) (setq ddv 0.0))
(if (/= nh nil) (setq ddh (getreal "\nDimensions of horizontal bars - d/d , d= : ")) (setq ddh 0.0))
(setvar "osmode" 0)
(command "ucs" "3p" pt1 pt2 pt3)
(setq o '(0 0 0))
(setvar "osmode" 35)
(setq pt5 (getpoint o "\nInput normal vector of UCS - inside point of opening in wall : "))
(command "ucs" "za" o pt5)
(setvar "osmode" 0)
(setq pt1u (trans pt1 0 1))
(setq pt2u (trans pt2 0 1))
(setq pt3u (trans pt3 0 1))
(setq pt4u (trans pt4 0 1))
(command "pline" pt1u pt2u pt3u pt4u "c")
(setq spl1 (ssadd))
(ssadd (entlast) spl1)
(setq ptsu (cal "(pt1u+pt2u+pt3u+pt4u)/4"))
(command "offset" a spl1 ptsu "")
(setq spl2 (ssadd))
(ssadd (entlast) spl2)
(command "extrude" spl1 "" d "")
(setq sspl1 (ssadd))
(ssadd (entlast) sspl1)
(command "extrude" spl2 "" d "")
(setq sspl2 (ssadd))
(ssadd (entlast) sspl2)
(command "subtract" sspl1 "" sspl2 "" "")
(setq -a (- 0 a))
(setq -z (- 0 z))
(setq a1 (list -a a z))
(setq pt1uu (cal "pt1u+a1"))
(setq a2 (list a a z))
(setq pt2uu (cal "pt2u+a2"))
(setq a3 (list a -a z))
(setq pt3uu (cal "pt3u+a3"))
(setq a4 (list -a -a z))
(setq pt4uu (cal "pt4u+a4"))

(if (eq b 0) ()
(progn
(command "pline" pt1uu pt2uu pt3uu pt4uu "c")
(setq splu1 (ssadd))
(ssadd (entlast) splu1)
(setq ptsuu (cal "(pt1uu+pt2uu+pt3uu+pt4uu)/4"))
(command "offset" b splu1 ptsuu "")
(setq splu2 (ssadd))
(ssadd (entlast) splu2)
(command "extrude" splu1 "" b "")
(setq ssplu1 (ssadd))
(ssadd (entlast) ssplu1)
(command "extrude" splu2 "" b "")
(setq ssplu2 (ssadd))
(ssadd (entlast) ssplu2)
(command "subtract" ssplu1 "" ssplu2 "" "")
(setq -b (- 0 b))
(setq bp (/ b 2))
(setq -bp (- 0 bp))
(setq b1 (list -b b bp))
(setq pt1uuu (cal "pt1uu+b1"))
(setq b2 (list b b bp))
(setq pt2uuu (cal "pt2uu+b2"))
(setq b3 (list b -b bp))
(setq pt3uuu (cal "pt3uu+b3"))
(setq b4 (list -b -b bp))
(setq pt4uuu (cal "pt4uu+b4"))
(command "pline" pt1uuu pt2uuu pt3uuu pt4uuu "c")
(setq stak (ssadd))
(ssadd (entlast) stak)
(command "extrude" stak "" bp "")
))

(if (/= nv nil)
(progn
(setq v (distance pt1uu pt4uu))
(setq dv (/ v (+ nh 1)))
(setq -dv (- 0 dv))
(setq ov (list 0 dv 0))
(setq -ddv (- 0 ddv))
(setq ddvp (/ ddv 2))
(setq ptuuev (list -ddv v 0))
(setq ptuuendv (cal "pt1uu+ptuuev"))
(command "rectangle" pt1uu ptuuendv "")
(setq vpr (ssadd))
(ssadd (entlast) vpr)
(command "extrude" vpr "" ddv "")
(setq v1 (ssadd))
(ssadd (entlast) v1)
(setq ptx (list ddvp 0 0))
(command "move" v1 "" o ptx)
(repeat (fix nv)
(command "copy" (entlast) "" o oh)
)
(command "erase" v1 "")
))

(if (/= nh nil)
(progn
(setq h (distance pt1uu pt2uu))
(setq dh (/ h (+ nv 1)))
(setq -dh (- 0 dh))
(setq oh (list -dh 0 0))
(setq -h (- 0 h))
(setq ddhp (/ ddh 2))
(setq -ddhp (- 0 ddhp))
(setq ptuueh (list -h ddh 0))
(setq ptuuendh (cal "pt1uu+ptuueh"))
(command "rectangle" pt1uu ptuuendh "")
(setq hpr (ssadd))
(ssadd (entlast) hpr)
(command "extrude" hpr "" ddh "")
(setq h1 (ssadd))
(ssadd (entlast) h1)
(setq pty (list 0 -ddhp 0))
(command "move" h1 "" o pty)
(repeat (fix nh)
(command "copy" (entlast) "" o ov)
)
(command "erase" h1 "")
))

(if (and (eq aa 0) (eq aaa 0)) ()
(progn
(setq -aa (- 0 aa))
(setq aa1 (list aa -aa 0))
(setq pt1aa (cal "pt1u+aa1"))
(setq aa2 (list -aa -aa 0))
(setq pt2aa (cal "pt2u+aa2"))
(setq aa3 (list -aa aa 0))
(setq pt3aa (cal "pt3u+aa3"))
(setq aa4 (list aa aa 0))
(setq pt4aa (cal "pt4u+aa4"))
(setq -aaa (- 0 aaa))
(command "pline" pt1aa pt2aa pt3aa pt4aa "c")
(setq spla1 (ssadd))
(ssadd (entlast) spla1)
(command "offset" aa spla1 ptsu "")
(setq spla2 (ssadd))
(ssadd (entlast) spla2)
(command "extrude" spla1 "" -aaa "")
(setq sspla1 (ssadd))
(ssadd (entlast) sspla1)
(command "extrude" spla2 "" -aaa "")
(setq sspla2 (ssadd))
(ssadd (entlast) sspla2)
(command "subtract" sspla1 "" sspla2 "" "")
))

(command "ucs" "w")
(setvar "osmode" oscmd)

(princ)
)

Hope this helps... To me it helped lots of times...
Marko Ribar, d.i.a. (architect)
 

Hi Marko,
 His routine is very interesting, but unfortunately does not make what I need.
 Accurate data frame with the window and the design of the window to capture the information block.

 Even so, thank you for your attention.

[ribarm]

The code wasn't properly debugged, and I've modified it a little...

Code - Auto/Visual Lisp: [Select]

1. (defun c:3d-w ( / -A -AA -AAA -B -BP -DDHP -DDV -DH -DV -H -Z A A1 A2 A3 A4 AA AA1 AA2 AA3 AA4 AAA B B1 B2 B3 B4 BP D DDH DDHP DDV DDVP DH DV H H1 HPR NH NV O OH OSCMD OV PT1 PT1AA PT1U PT1UU PT1UUU PT2 PT2AA PT2U PT2UU PT2UUU PT3 PT3AA PT3U PT3UU PT3UUU PT4 PT4AA PT4U PT4UU PT4UUU PT5 PTSU PTSUU PTUUEH PTUUENDH PTUUENDV PTUUEV PTX PTY SPL1 SPL2 SPLA1 SPLA2 SPLU1 SPLU2 SSPL1 SSPL2 SSPLA1 SSPLA2 SSPLU1 SSPLU2 STAK V V1 VPR Z )
2. (setq oscmd (getvar "osmode"))
3. (setvar "osmode" 35)
4. (arxload "geomcal.arx")
5. (prompt "\nMODELING 3D WINDOW OR DOOR OR FILLING OPENING WITH BARS - ENTER TO CONTINUE")
6. (print)
7. (textscr)
8. (command pause)
9. (command "ucs" "w")
10. (setq pt1 (getpoint "\nPick first point of outer edge of wall opening - lower left : "))
11. (setq pt2 (getpoint "\nPick second point of outer edge of wall opening - lower right : "))
12. (setq pt3 (getpoint "\nPick third point of outer edge of wall opening - upper right : "))
13. (setq pt4 (getpoint "\nPick fourth point of outer edge of wall opening - upper left : "))
14. (setq d (getdist pt1 "\nInput width of window : "))
15. (setq a 0.0)
16. (while (eq a 0.0) (setq a (getdist "\nInput thickness of outer frame of window - <must be more than 0 - 2 points> : ")))
17. (setq b (getdist "\nInput thickness of inner frame of window - <0=no inner frame and no glass solid box - 2 points> : "))
18. (setq z (getdist "\nInput gap from outer edge of opening to inner frame of window - <0=plane of outer edge - 2 points> : "))
19. (setq nv (getreal "\nNumber of vertical bars - <ENTER - 0> : "))
20. (setq nh (getreal "\nNumber of horizontal bars - <ENTER - 0> : "))
21. (setq aa (getdist "\nInput width of outer frame around opening - <ENTER - 0> : "))
22. (if (eq aa nil) (setq aa 0))
23. (if (eq aa 0) (setq aaa 0)
24. (setq aaa (getdist "\nInput thickness of outer frame around opening - frontal extrusion in front of opening - < 2 points > : "))
25. )
26. (if (and (/= nv 0) (/= nv nil)) (setq ddv (getreal "\nDimensions of vertical bars - d/d , d= : ")) (setq ddv 0.0 nv 0))
27. (if (and (/= nh 0) (/= nh nil)) (setq ddh (getreal "\nDimensions of horizontal bars - d/d , d= : ")) (setq ddh 0.0 nh 0))
28. (setvar "osmode" 0)
29. (command "ucs" "3p" pt1 pt2 pt3)
30. (setq o '(0 0 0))
31. (setvar "osmode" 35)
32. (setq pt5 (getpoint o "\nInput normal vector of UCS - inside point of opening in wall : "))
33. (command "ucs" "za" o pt5)
34. (setvar "osmode" 0)
35. (setq pt1u (trans pt1 0 1))
36. (setq pt2u (trans pt2 0 1))
37. (setq pt3u (trans pt3 0 1))
38. (setq pt4u (trans pt4 0 1))
39. (command "pline" pt1u pt2u pt3u pt4u "c")
40. (setq spl1 (ssadd))
41. (ssadd (entlast) spl1)
42. (setq ptsu (cal "(pt1u+pt2u+pt3u+pt4u)/4"))
43. (command "offset" a spl1 ptsu "")
44. (setq spl2 (ssadd))
45. (ssadd (entlast) spl2)
46. (command "extrude" spl1 "" d "")
47. (setq sspl1 (ssadd))
48. (ssadd (entlast) sspl1)
49. (command "extrude" spl2 "" d "")
50. (setq sspl2 (ssadd))
51. (ssadd (entlast) sspl2)
52. (command "subtract" sspl1 "" sspl2 "" "")
53. (setq -a (- 0 a))
54. (setq -z (- 0 z))
55. (setq a1 (list -a a z))
56. (setq pt1uu (cal "pt1u+a1"))
57. (setq a2 (list a a z))
58. (setq pt2uu (cal "pt2u+a2"))
59. (setq a3 (list a -a z))
60. (setq pt3uu (cal "pt3u+a3"))
61. (setq a4 (list -a -a z))
62. (setq pt4uu (cal "pt4u+a4"))
63.  
64. (if (not (eq b 0))
65. (progn
66. (command "pline" pt1uu pt2uu pt3uu pt4uu "c")
67. (setq splu1 (ssadd))
68. (ssadd (entlast) splu1)
69. (setq ptsuu (cal "(pt1uu+pt2uu+pt3uu+pt4uu)/4"))
70. (command "offset" b splu1 ptsuu "")
71. (setq splu2 (ssadd))
72. (ssadd (entlast) splu2)
73. (command "extrude" splu1 "" b "")
74. (setq ssplu1 (ssadd))
75. (ssadd (entlast) ssplu1)
76. (command "extrude" splu2 "" b "")
77. (setq ssplu2 (ssadd))
78. (ssadd (entlast) ssplu2)
79. (command "subtract" ssplu1 "" ssplu2 "" "")
80.  
81. (setq -b (- 0 b))
82. (setq bp (/ b 2))
83. (setq -bp (- 0 bp))
84. (setq b1 (list -b b bp))
85. (setq pt1uuu (cal "pt1uu+b1"))
86. (setq b2 (list b b bp))
87. (setq pt2uuu (cal "pt2uu+b2"))
88. (setq b3 (list b -b bp))
89. (setq pt3uuu (cal "pt3uu+b3"))
90. (setq b4 (list -b -b bp))
91. (setq pt4uuu (cal "pt4uu+b4"))
92.  
93. (command "pline" pt1uuu pt2uuu pt3uuu pt4uuu "c")
94. (setq stak (ssadd))
95. (ssadd (entlast) stak)
96. (command "extrude" stak "" bp "")
97. ))
98.  
99. (setq v (distance pt1uu pt4uu))
100. (setq dv (/ v (+ nh 1)))
101. (setq -dv (- 0 dv))
102. (setq ov (list 0 dv 0))
103. (setq -ddv (- 0 ddv))
104. (setq ddvp (/ ddv 2))
105. (setq ptuuev (list -ddv v 0))
106. (setq ptuuendv (cal "pt1uu+ptuuev"))
107.  
108. (setq h (distance pt1uu pt2uu))
109. (setq dh (/ h (+ nv 1)))
110. (setq -dh (- 0 dh))
111. (setq oh (list -dh 0 0))
112. (setq -h (- 0 h))
113. (setq ddhp (/ ddh 2))
114. (setq -ddhp (- 0 ddhp))
115. (setq ptuueh (list -h ddh 0))
116. (setq ptuuendh (cal "pt1uu+ptuueh"))
117.  
118. (if (/= nv 0)
119. (progn
120. (command "rectangle" pt1uu ptuuendv "")
121. (setq vpr (ssadd))
122. (ssadd (entlast) vpr)
123. (command "extrude" vpr "" ddv "")
124. (setq v1 (ssadd))
125. (ssadd (entlast) v1)
126. (setq ptx (list ddvp 0 0))
127. (command "move" v1 "" o ptx)
128. (repeat (fix nv)
129. (command "copy" (entlast) "" o oh)
130. )
131. (command "erase" v1 "")
132. ))
133.  
134. (if (/= nh 0)
135. (progn
136. (command "rectangle" pt1uu ptuuendh "")
137. (setq hpr (ssadd))
138. (ssadd (entlast) hpr)
139. (command "extrude" hpr "" ddh "")
140. (setq h1 (ssadd))
141. (ssadd (entlast) h1)
142. (setq pty (list 0 -ddhp 0))
143. (command "move" h1 "" o pty)
144. (repeat (fix nh)
145. (command "copy" (entlast) "" o ov)
146. )
147. (command "erase" h1 "")
148. ))
149.  
150. (if (not (and (eq aa 0) (eq aaa 0)))
151. (progn
152.  
153. (setq -aa (- 0 aa))
154. (setq aa1 (list aa -aa 0))
155. (setq pt1aa (cal "pt1u+aa1"))
156. (setq aa2 (list -aa -aa 0))
157. (setq pt2aa (cal "pt2u+aa2"))
158. (setq aa3 (list -aa aa 0))
159. (setq pt3aa (cal "pt3u+aa3"))
160. (setq aa4 (list aa aa 0))
161. (setq pt4aa (cal "pt4u+aa4"))
162.  
163. (setq -aaa (- 0 aaa))
164.  
165. (command "pline" pt1aa pt2aa pt3aa pt4aa "c")
166. (setq spla1 (ssadd))
167. (ssadd (entlast) spla1)
168. (command "offset" aa spla1 ptsu "")
169. (setq spla2 (ssadd))
170. (ssadd (entlast) spla2)
171. (command "extrude" spla1 "" -aaa "")
172. (setq sspla1 (ssadd))
173. (ssadd (entlast) sspla1)
174. (command "extrude" spla2 "" -aaa "")
175. (setq sspla2 (ssadd))
176. (ssadd (entlast) sspla2)
177. (command "subtract" sspla1 "" sspla2 "" "")
178. ))
179.  
180. (command "ucs" "w")
181. (setvar "osmode" oscmd)
182.  
183. (princ)
184. )
185.  

M.R. (Hope this has now sense since I am using it constantly...)