[编程交流] 管道弯头

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

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