我不久前做了这个，不确定它是否有用
- (defun c:duct (/ *error* oVars vLst p1 p2 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" "CLAYER" "FILLMODE" "OSMODE" "PLINEWID")
- oVars (mapcar 'getvar vLst))
- (setvar "CMDECHO" 0)
- (setvar "FILLMODE" 0)
- (if (not (tblsearch "LAYER" "DUCT"))
- (command "-layer" "M" "DUCT" "_C" "1" "DUCT" "")
- (setvar "CLAYER" "DUCT"))
- (vl-load-com)
- (if (and (setq p1 (getpoint "\nSpecify First Point: ")
- p2 (getpoint p1 "\nIndicate Direction of Duct: ")))
- (progn
- (setvar "PLINEWID" 6)
- (setvar "OSMODE" 0)
- (command "_pline" p1 (polar p1 (angle p1 p2) 2.0) "_arc")
- (while (> (getvar "CMDACTIVE") 0) (command pause))
- (setq vEnt (vlax-ename->vla-object (entlast))
- i 2.0)
- (while (and (setq PntEve (vlax-curve-GetPointatDist vEnt i)
- PntOdd (vlax-curve-GetPointatDist vEnt (setq i (1+ 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 (1+ i)))
- (vla-put-ConstantWidth vEnt 0.0)
- (vla-put-Color vEnt acblue))
- (princ "\n<!> Points Specified Incorrectly <!>"))
- (mapcar 'setvar vLst oVars)
- (princ))
| 
