Tharwat 发表于 2022-7-6 10:54:22

Lisp制作矩形

你好
我制作了一个名为Beam的Lisp文件。lsp,它正在生成矩形,但无法生成圆;
(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 (polarp3 (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)))
))



 
任何帮助都将不胜感激。
我的问候。
萨尔瓦特

Small Fish 发表于 2022-7-6 11:11:38

好的,试试这个:
刚意识到你想把主打杆放在上面,我就把它们放在了底部——但你可以根据需要进行调整。(仅梁钢筋位于顶部-非常奇怪!)
你的马镫角没有弯曲,所以我添加了它们。
我还添加了一个名为“cover”的变量,该变量在绘制钢筋截面时至关重要。
还有其他方面可以改进,但这只是一个开始。。。。
 
hth公司
小鱼
 

(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)))
))

Tharwat 发表于 2022-7-6 11:37:15

 
非常感谢您对我的lisp文件所做的辛勤工作。
我的Lisp程序的姿势将使一个梁的钢筋向上和向下,以及,我没有包括他们,因为我失去了在开始,我集中在用户输入,阻止我达到它的最后,使低下降酒吧的功能,这就是为什么你说这是非常奇怪,但它不是在现实中。
 
你的lisp给了我帮助,但我仍在努力,以获得lisp的最佳性能。
 
再次感谢您的善意帮助。
你的
塔瓦特

Small Fish 发表于 2022-7-6 11:42:50

不客气,很乐意帮忙。
 
更多建议-由于您有许多输入变量,最好创建一个对话框,而不是命令行驱动的提示。
-您应该在其中一个上角显示箍筋的末端。
 
旧金山

Tharwat 发表于 2022-7-6 12:05:19

你好
 
我确实同意你的建议,我以前确实想过这一点,但处理DCL会增加更多功能,这是时间问题。
 
我很快就会用DCL试试。
 
谢谢你的关心
塔瓦特
页: [1]
查看完整版本: Lisp制作矩形