管道弯头
我们得到了一个从100毫米到1000毫米的铝管系统的大型项目，涉及许多弯头。我的问题是：是否有地方可以用lisp绘制弯头的侧视图，只需用户输入：管道外径、管段直径和弯头角度。请帮助：） 先试试这个：
(defun c:duct (/ *error* oVars vLst dPt dOd Segs dAng vEnt i PntEve PntOdd
cAngE sPtE ePtE cAngO sPtO ePtO last_pt1 last_pt2)
(defun *error* (msg)
(if oVars (mapcar 'setvar vLst oVars))
(princ (strcat "\nError: " (strcase msg))) (princ))
(setq vLst '("CMDECHO" "OSMODE")
oVars (mapcar 'getvar vLst))
(if (and (setq dPt (getpoint "\nSelect Point for Elbow: "))
(not (initget 7)) (setq dOd (getdist "\nSpecify Duct OD: "))
(not (initget 7)) (setq Segs (getint "\nSpecify No. of Segments: "))
(setq dAng (getreal "\nSpecify Elbow Angle: ")) (< 0 dAng 360))
(progn
(mapcar 'setvar vlst '(0 0))
(command "_arc" "_C" (polar dPt (/ pi 2) dOd) dPt "_A" (rtos dAng))
(setq vEnt (vlax-ename->vla-object (entlast)) i 0.0 inc (/ (vla-get-ArcLength vEnt) Segs))
(while (or(setq PntEve (vlax-curve-GetPointatDist vEnt i)
PntOdd (vlax-curve-GetPointatDist vEnt (setq i (+ inc i)))))
(setq cAngE (+ (/ pi 2) (angle '(0 0 0) (vlax-curve-getFirstDeriv vEnt
(vlax-curve-GetParamAtPoint vEnt PntEve)))))
(command "_line" (setq sPtE (polar PntEve cAngE 4.0)) (setq ePtE (polar PntEve (+ pi cAngE) 4.0)) "")
(if (and last_pt1 last_pt2) (progn (command "_line" last_pt1 sPtE "") (command "_line" last_pt2 ePtE "")))
(setq cAngO (+ (/ pi 2) (angle '(0 0 0) (vlax-curve-getFirstDeriv vEnt
(vlax-curve-GetParamAtPoint vEnt PntOdd)))))
(command "_line" (setq sPtO (polar PntOdd cAngO 3.0)) (setq ePtO (polar PntOdd (+ pi cAngO) 3.0)) "")
(command "_line" sPtE sPtO "") (command "_line" ePtE ePtO "")
(setq last_pt1 sPtO last_pt2 ePtO)
(setq i (+ inc i)))
(vla-put-Color vEnt acblue))
(princ "\n<!> Points Specified Incorrectly <!>"))
(mapcar 'setvar vLst oVars)
(princ))
很抱歉，这样更好：
(defun c:duct(/ *error* oVars vLst dPt dOd Segs dAng vEnt i PntEve
PntOdd cAngE sPtE ePtE cAngO sPtO ePtO last_pt1 last_pt2)
(defun *error*(msg)
(if oVars (mapcar 'setvar vLst oVars))
(princ (strcat "\nError: " (strcase msg))) (princ))
(setq vLst'("CMDECHO" "OSMODE")
oVars (mapcar 'getvar vLst))
(if (and (setq dPt (getpoint "\nSelect Point for Elbow: "))
(not (initget 7)) (setq dOd (getdist "\nSpecify Duct OD: "))
(not (initget 7)) (setq Segs (getint "\nSpecify No. of Segments: "))
(setq dAng (getreal "\nSpecify Elbow Angle: ")) (< 0 dAng 360))
(progn
(mapcar 'setvar vlst '(0 0))
(command "_arc" "_C" (polar dPt (/ pi 2) (* 1.5 dOd)) dPt "_A" (rtos dAng))
(setq vEnt (vlax-ename->vla-object (entlast)) i 0.0 inc (/ (vla-get-ArcLength vEnt) Segs))
(while (setq PntEve (vlax-curve-GetPointatDist vEnt i))
(setq cAngE (+ (/ pi 2) (angle '(0 0 0) (vlax-curve-getFirstDeriv vEnt
(vlax-curve-GetParamAtPoint vEnt PntEve)))))
(command "_line" (setq sPtE (polar PntEve cAngE (/ (+ dOd (* inc 2.0)) 2.0)))
(setq ePtE (polar PntEve (+ pi cAngE) (/ (+ dOd (* inc 2.0)) 2.0))) "")
(if (and last_pt1 last_pt2) (progn (command "_line" last_pt1 sPtE "") (command "_line" last_pt2 ePtE "")))
(if (setq PntOdd (vlax-curve-GetPointatDist vEnt (setq i (+ inc i))))
(progn
(setq cAngO (+ (/ pi 2) (angle '(0 0 0) (vlax-curve-getFirstDeriv vEnt
(vlax-curve-GetParamAtPoint vEnt PntOdd)))))
(command "_line" (setq sPtO (polar PntOdd cAngO (/ dOd 2.0)))
(setq ePtO (polar PntOdd (+ pi cAngO) (/ dOd 2.0))) "")
(command "_line" sPtE sPtO "") (command "_line" ePtE ePtO "")
(setq last_pt1 sPtO last_pt2 ePtO i (+ inc i)))))
(vla-put-Color vEnt acblue))
(princ "\n<!> Points Specified Incorrectly <!>"))
(mapcar 'setvar vLst oVars)
(princ))
李，这个rutine的Autocad版本有什么限制吗？
见图纸。
肘部图纸 不是限制，我只是觉得你想要这样的管道：
好的，我在Lisp程序的顶部给了你一个“调整菜单”，你可以一直玩到心满意足为止
(defun c:duct(/ *error* oVars vLst dPt dOd Segs dAng vEnt i PntEve PntOdd
cAngE sPtE ePtE cAngO sPtO ePtO last_pt1 last_pt2 Cent str)
;; ==== Adjustments ====
(setq Cent T) ; Duct Centreline
(setq str T) ; Straight/Corrugated Duct (T = Straight, nil = Corrugated)
;; =====================
(defun *error*(msg)
(if oVars (mapcar 'setvar vLst oVars))
(princ (strcat "\nError: " (strcase msg)))
(princ))
(setq vLst'("CMDECHO" "OSMODE")
oVars (mapcar 'getvar vLst))
(if (and (setq dPt (getpoint "\nSelect Point for Elbow: "))
(not (initget 7))
(setq dOd (getdist "\nSpecify Duct OD: "))
(not (initget 7))
(setq Segs (getint "\nSpecify No. of Segments: "))
(setq dAng (getreal "\nSpecify Elbow Angle: "))
(< 0 dAng 360))
(progn
(mapcar 'setvar vlst '(0 0))
(or (and str (setq j 0.0)) (setq j 1.0))
(command "_arc" "_C" (polar dPt (/ pi 2) (* 1.5 dOd)) dPt "_A" (rtos dAng))
(setq vEnt (vlax-ename->vla-object (entlast))
i 0.0
inc (/ (vla-get-ArcLength vEnt) Segs))
(while (setq PntEve (vlax-curve-GetPointatDist vEnt i))
(setq cAngE (+ (/ pi 2) (angle '(0 0 0) (vlax-curve-getFirstDeriv vEnt
(vlax-curve-GetParamAtPoint vEnt PntEve)))))
(command "_line" (setq sPtE (polar PntEve cAngE (/ (+ dOd (* j inc 2.0)) 2.0)))
(setq ePtE (polar PntEve (+ pi cAngE) (/ (+ dOd (* j inc 2.0)) 2.0))) "")
(if (and last_pt1 last_pt2)
(progn (command "_line" last_pt1 sPtE "") (command "_line" last_pt2 ePtE "")))
(if (setq PntOdd (vlax-curve-GetPointatDist vEnt (setq i (+ inc i))))
(progn
(setq cAngO (+ (/ pi 2) (angle '(0 0 0) (vlax-curve-getFirstDeriv vEnt
(vlax-curve-GetParamAtPoint vEnt PntOdd)))))
(command "_line" (setq sPtO (polar PntOdd cAngO (/ dOd 2.0)))
(setq ePtO (polar PntOdd (+ pi cAngO) (/ dOd 2.0))) "")
(command "_line" sPtE sPtO "")
(command "_line" ePtE ePtO "")
(setq last_pt1 sPtO last_pt2 ePtO i (+ inc i)))))
(if Cent (vla-put-Color vEnt acblue) (vla-delete vEnt)))
(princ "\n<!> Points Specified Incorrectly <!>"))
(mapcar 'setvar vLst oVars)
(princ))
我会在家试试。非常感谢李
没问题，我做得很开心 完美的
李，我会解释。。。
在附着的dwg上
肘部。图纸 好的，我回家后会看一看的
页:
[1]
2