[编程交流] Lisp制作矩形

(defun c:beam (/ width height UpperBarsDia LowBarDia p1 oldsnap oldortho newortho p2 p3 p4 )
 (if (< (setq width (cond ((getdist(strcat"\nSpecify beam Width <min 100>:")))))
   (* 50 2))
(progn
       (alert "Width of beam must be minimum 150")
       (c:beam)))
 (if (< (setq height (cond ((getdist(strcat"\nSpecify beam Height <min 100>: ")))))
(* 50 2))
  (progn
   (alert "Height of Beam must be minimum 150")
   (exit))
          (princ))
 (initget "2 3 4")
 (setq UpperBarsQTY (getkword "\nSpecify number of Upper Bars <2 3 4>:")); Upper side Bars quantity 
 (setq UpDia (getint"\nSpecify Upper Bars Diameter:")
UpRad (/ UpDia 2))                                                  ; Upper Bars Diameter  
 (setq p1 (getpoint"\nSpecify Point:"))
 (setq oldsnap (getvar "osmode"))
 (setq oldortho (getvar "orthomode"))
 (setq newsnap (setvar "osmode" 0))
 (setq newortho (setvar "orthomode" 0))
 (setq p2 (polar p1 (dtr 0.0) width))
 (setq p3 (polar p2 (dtr -90.0) height))
 (setq p4 (polar  p3 (dtr -180) width))
  (small_rect)
  (command "_pline" p1 "_w" 0 0 p2 p3 p4 "_c" ""
   "_pline" st st1 st2 st3 "_c" "")
 (setvar "osmode" oldsnap)
 (setvar "orthomode" oldortho)
 (princ)
  (cond
   ((eq UpperBarsQTY 2)(1Circle)(4Circle))
   ((eq UpperBarsQTY 3)(1Circle)(CenterCircle)(4Circle))
   ((eq UpperBarsQTY 4)(1Circle)(2Circle)(3Circle)(4Circle)))
 (setq off 25.0
  st (list (+ (car p1) off)
           (- (cadr p1) off)
          )
  st1(polar st 0.0 (- width (* off 2)))
  st2(polar st1 (dtr -90) (- height (* off 2)))
  st3(polar st2 (dtr -180) (- width (* off 2)))
  )
  (setq Dist1 (distance st st1)
Center (/ Dis1 2)
Qrtr (/ dist 4)
Qrtr2 (* Qrtr 2))
 (setq 1CirLoc (list(+ (car st)UpRad)(-(cadr st)UpRad))
CenterCircleLoc(list(-(+ (car st)Center)UpRad)(- (cadr st) UpRad))
2CirLoc (list(-(+ (car st)Qrtr)UpRad)(- (cadr st) UpRad))
3CirLoc (list(-(+ (car st) Qrtr2)UpRad)(- (cadr st) UpRad))
4CirLoc (list (-(+ (car st)Dist1)UpRad)(-(cadrst)UpRad)))
 )
 ;----------------------------------------------------------------------------------------
 (defun DTR (ang)(* pi (/ ang 180.0)))
 ;----------------------------------------------------------------------------------------
 (defun 1Circle ()(entmake (list '(0 . "CIRCLE")(cons 10 1CirLoc )(cons 40 UpRad)))(princ))      
 (defun CenterCircle()(entmake (list '(0 . "CIRCLE")(cons 10 CenterCircleLoc)(cons 40 LowRad)))(princ))
 (defun 2Circle ()(entmake (list '(0 . "CIRCLE")(cons 10 2CirLoc)(cons 40 LowRad)))(princ))
 (defun 3Circle ()(entmake (list '(0 . "CIRCLE")(cons 10 3CirLoc)(cons 40 LowRad)))(princ))
 (defun 4Circle ()(entmake (list '(0 . "CIRCLE")(cons 10 4CirLoc)(cons 40 LowRad)))(princ)) 
 ;----------------------------------------------------------------------------------------
 (defun small_rect ()
       (setq off 25.0
  st (list (+ (car p1) off)
           (- (cadr p1) off)
          )
  st1(polar st 0.0 (- width (* off 2)))
  st2(polar st1 (dtr -90) (- height (* off 2)))
  st3(polar st2 (dtr -180) (- width (* off 2)))
  ))
 

 
(defun c:beam (/ width height UpperBarsDia LowBarDia
p1 oldsnap oldortho newortho
p2 p3 p4 cover Pt1 Pt2
Pt3 Pt4 cpt1 Pt5 Pt6 Pt7
Pt8 Pt9 Pt10 Pt11 Pt12 cpt2
cover cpt3 cpt4 Pt14 Pt15 Pt16
Pt17 cpt1a cpt1b cpt1c e1 e2 e3 e4 e5 e6 e7 e8
)
(if (< (setq width (cond ((getdist(strcat"\nSpecify beam Width <min 100>:")))))
(* 50 2))
(progn
(alert "Width of beam must be minimum 150")
(c:beam)))
(if (< (setq height (cond ((getdist(strcat"\nSpecify beam Height <min 100>: ")))))
(* 50 2))
(progn
(alert "Height of Beam must be minimum 150")
(exit))
(princ))
(initget "2 3 4")
(setq UpperBarsQTY (getkword "\nSpecify number of Upper Bars <2 3 4>:")); Upper side Bars quantity 
(setq UpDia (getint"\nSpecify Upper Bars Diameter: "))
(setq cover (getint"\nSpecify cover: ")) 
(setq UpRad (/ UpDia 2)) ; Upper Bars Diameter 
(setq p1 (getpoint"\nSpecify Point:"))
(setq oldsnap (getvar "osmode"))
(setq oldortho (getvar "orthomode"))
(setq newsnap (setvar "osmode" 0))
(setq newortho (setvar "orthomode" 0))
(setq p2 (polar p1 (dtr 0.0) width))
(setq p3 (polar p2 (dtr -90.0) height))
(setq p4 (polar p3 (dtr -180) width))
(small_rect)
(command "layer" "make" "Concrete" "ltype" "continuous" "" "color" "yellow" "" "")
(command "layer" "set" "Concrete" "")
(command "_pline" p1 "_w" 0 0 p2 p3 p4 "_c" ""
;;; "_pline" st st1 st2 st3 "_c" ""
)
(setvar "osmode" oldsnap)
(setvar "orthomode" oldortho)
;;; (princ)
;----------------
;Calculate points
;----------------
;Rebar bottom Rhs
(setq Pt1 (polar p4 (* 0.5 pi) (+ cover (/ UpDia 2)));beam edge lhs
Pt2 (polar Pt1 0 cover);tangent point top Lhs
cpt1 (polar Pt2 0 (/ UpDia 2));centrepoint of main bar
pt3 (polar p4 0 (+ cover (/ UpDia 2)));beam edge bottom
Pt4 (polar Pt3 (* 0.5 pi) cover);tangent point bottom Lhs
;Rebar bottom Lhs
Pt5 (polar p3 (* 0.5 pi) (+ cover (/ UpDia 2)));beam edge Rhs
Pt6 (polar Pt5 pi cover);tangent point top Rhs
cpt2(polar Pt6 pi (/ UpDia 2));centrepoint of main bar
pt7 (polar p3 pi (+ cover (/ UpDia 2)));beam edge bottom
Pt8 (polar Pt7 (* 0.5 pi) cover);tangent point bottom Rhs
;Rebar Top Rhs
Pt9 (polar p1 (* 1.5 pi) (+ cover (/ UpDia 2)));beam edge lhs
Pt10 (polar Pt9 0 cover);tangent point top Lhs
cpt3 (polar Pt10 0 (/ UpDia 2));centrepoint of main bar
pt11 (polar p1 0 (+ cover (/ UpDia 2)));beam edge bottom
Pt12 (polar Pt11 (* 1.5 pi) cover);tangent point bottom Lhs
;Rebar Top Lhs
Pt13 (polar p2 (* 1.5 pi) (+ cover (/ UpDia 2)));beam edge lhs
Pt14 (polar Pt13 pi cover);tangent point top Lhs
cpt4 (polar Pt14 pi (/ UpDia 2));centrepoint of main bar
pt15 (polar p2 pi (+ cover (/ UpDia 2)));beam edge bottom
Pt16 (polar Pt15 (* 1.5 pi) cover);tangent point bottom Lhs
CornerBarDist (Distance cpt1 cpt2);Distance between to main bars
cpt1a (polar cpt1 0 (/ CornerBarDist 2));middle bar centrepoint
cpt1b (polar cpt1 0 (/ CornerBarDist 3));first middle main bar
cpt1c (polar cpt1 0 (*(/ CornerBarDist 3)2));second middle main bar
);setq
;---------------
;Draw components
;---------------
;Draw stirrup
(command "layer" "make" "Main Rebar" "ltype" "continuous" "" "color" "cyan" "" "")
(command "layer" "set" "Main Rebar" "")
(cond ((= UpperBarsQTY "2")
(progn
(command "circle" cpt2 (/ UpDia 2) "");Draw rhs main bar
(command "circle" cpt1 (/ UpDia 2) "");Draw lhs main bar
))
( (= UpperBarsQTY "3")
(progn
(command "circle" cpt2 (/ UpDia 2) "");Draw rhs main bar
(command "circle" cpt1 (/ UpDia 2) "");Draw lhs main bar
(command "circle" cpt1a (/ UpDia 2) "");Draw centre main bar
))
((= UpperBarsQTY "4")
(progn
(command "circle" cpt2 (/ UpDia 2) "");Draw rhs main bar
(command "circle" cpt1 (/ UpDia 2) "");Draw lhs main bar
(command "circle" cpt1b (/ UpDia 2) "");Draw first middle main bar
(command "circle" cpt1c (/ UpDia 2) "");Draw second middle main bar
))
);cond
;Draw stirrup
(command "layer" "make" "Stirrup" "ltype" "continuous" "" "color" "green" "" "")
(command "layer" "set" "Stirrup" "")
(command "ARC" Pt2 "e" Pt4 cpt1);left curve of stirrup
(setq e1 (entlast))
(command "ARC" Pt8 "e" Pt6 cpt2);right curve of stirrup
(setq e2 (entlast))
(command "ARC" Pt12 "e" Pt9 cpt3);right curve of stirrup
(setq e3 (entlast))
(command "ARC" Pt14 "e" Pt16 cpt4);right curve of stirrup
(setq e4 (entlast))
(command "PLINE" Pt4 Pt8 "")
(setq e5 (entlast))
(command "PLINE" Pt2 Pt10 "")
(setq e6 (entlast))
(command "PLINE" Pt6 Pt14 "")
(setq e7 (entlast))
(command "PLINE" Pt16 Pt12 "")
(setq e8 (entlast))
(command "_.PEDIT" e5 "JOIN" e5 e2 e3 e4 e1 e6 e7 e8 "" "");make stirrup single a pline
;;; (cond
;;; ((eq UpperBarsQTY 2)(1Circle)(4Circle))
;;; ((eq UpperBarsQTY 3)(1Circle)(CenterCircle)(4Circle))
;;; ((eq UpperBarsQTY 4)(1Circle)(2Circle)(3Circle)(4Circle)))
;;; (setq off 25.0
;;; st (list (+ (car p1) off)
;;; (- (cadr p1) off)
;;; )
;;; st1(polar st 0.0 (- width (* off 2)))
;;; st2(polar st1 (dtr -90) (- height (* off 2)))
;;; st3(polar st2 (dtr -180) (- width (* off 2)))
;;; )
;;; (setq Dist1 (distance st st1)
;;; Center (/ Dis1 2)
;;; Qrtr (/ dist 4)
;;; Qrtr2 (* Qrtr 2))
;;; (setq 1CirLoc (list(+ (car st)UpRad)(-(cadr st)UpRad))
;;; CenterCircleLoc(list(-(+ (car st)Center)UpRad)(- (cadr st) UpRad))
;;; 2CirLoc (list(-(+ (car st)Qrtr)UpRad)(- (cadr st) UpRad))
;;; 3CirLoc (list(-(+ (car st) Qrtr2)UpRad)(- (cadr st) UpRad))
;;; 4CirLoc (list (-(+ (car st)Dist1)UpRad)(-(cadrst)UpRad)))
(princ)
)
;----------------------------------------------------------------------------------------
(defun DTR (ang)(* pi (/ ang 180.0)))
;----------------------------------------------------------------------------------------
;;; (defun 1Circle ()(entmake (list '(0 . "CIRCLE")(cons 10 1CirLoc )(cons 40 UpRad)))(princ)) 
;;; (defun CenterCircle()(entmake (list '(0 . "CIRCLE")(cons 10 CenterCircleLoc)(cons 40 LowRad)))(princ))
;;; (defun 2Circle ()(entmake (list '(0 . "CIRCLE")(cons 10 2CirLoc)(cons 40 LowRad)))(princ))
;;; (defun 3Circle ()(entmake (list '(0 . "CIRCLE")(cons 10 3CirLoc)(cons 40 LowRad)))(princ))
;;; (defun 4Circle ()(entmake (list '(0 . "CIRCLE")(cons 10 4CirLoc)(cons 40 LowRad)))(princ)) 
;----------------------------------------------------------------------------------------
(defun small_rect ()
(setq off 25.0
st (list (+ (car p1) off)
(- (cadr p1) off)
)
st1(polar st 0.0 (- width (* off 2)))
st2(polar st1 (dtr -90) (- height (* off 2)))
st3(polar st2 (dtr -180) (- width (* off 2)))
))