绘制方钢LISP程序

[QUOTE]用于绘制方钢,具体用法:[/QUOTE] [QUOTE]在cad命令行输入(ftdraw a b tt) a: 截面宽度 b:截面高度 tt:截面厚度[/QUOTE] [QUOTE](defun listtovariantArray (ptsList / arraySpace sArray)[/QUOTE] [QUOTE] (setq arraySpace[/QUOTE] [QUOTE] (vlax-make-safearray vlax-vbdouble (cons 0 (- (length ptsList) 1) ) ) )[/QUOTE] [QUOTE] (setq sArray (vlax-safearray-fill arraySpace ptsList)) [/QUOTE] [QUOTE] (vlax-make-variant sArray)[/QUOTE] [QUOTE])[/QUOTE] [QUOTE](defun ftdraw (a b tt / ptlst ptlstinner despt tmp mypoly mypoly1 acadObject AcadDocument mSpace ) [/QUOTE] [QUOTE](vl-load-com)[/QUOTE] [QUOTE] (setq acadObject (vlax-get-acad-object))[/QUOTE] [QUOTE] (setq acadDocument (vla-get-ActiveDocument acadObject))[/QUOTE] [QUOTE] (setq mSpace (vla-get-ModelSpace acadDocument))[/QUOTE] [QUOTE] (setq ptlst (list 0.0 0.0 (+ (/ a -2.0) (* 2.0 tt)) 0.0 (/ a -2.0) (* 2.0 tt) (/ a -2.0) (- b (* 2.0 tt)) (+ (/ a -2.0) (* 2.0 tt))[/QUOTE] [QUOTE] b (- (/ a 2.0) (* 2.0 tt)) b (/ a 2.0) (- b (* 2.0 tt)) (/ a 2.0) (* 2.0 tt) (- (/ a 2.0) (* 2.0 tt))[/QUOTE] [QUOTE] 0.0 0.0 0.0 ) )[/QUOTE] [QUOTE] (setq ptlstinner (list 0.0[/QUOTE] [QUOTE] tt (+ (/ a -2.0) (* 2.0 tt)) tt (+ (/ a -2.0) tt) (* 2.0 tt) (+ (/ a -2.0) tt)[/QUOTE] [QUOTE] (- b (* 2.0 tt)) (+ (/ a -2.0) (* 2.0 tt)) (- b tt) (- (/ a 2.0) (* 2.0 tt)) (- b tt) (- (/ a 2.0) tt)[/QUOTE] [QUOTE] (- b (* 2.0 tt)) (- (/ a 2.0) tt) (* 2.0 tt) (- (/ a 2.0) (* 2.0 tt)) tt 0.0 tt )[/QUOTE] [QUOTE] )[/QUOTE] [QUOTE] (setq mypoly (vla-addLightWeightPolyline mspace (listtovariantArray ptlst)))[/QUOTE] [QUOTE] (setq mypoly1 (vla-addLightWeightPolyline mspace (listtovariantArray ptlstinner)))[/QUOTE] [QUOTE] (setq tmp (- 0.0 (/ (sin (/ pi 8.0)) (cos (/ pi 8.0)))))[/QUOTE] [QUOTE] (vla-SetBulge mypoly 1 tmp)[/QUOTE] [QUOTE] (vla-SetBulge mypoly 3 tmp)[/QUOTE] [QUOTE] (vla-SetBulge mypoly 5 tmp)[/QUOTE] [QUOTE] (vla-SetBulge mypoly 7 tmp)[/QUOTE] [QUOTE] (vla-SetBulge mypoly1 1 tmp)[/QUOTE] [QUOTE] (vla-SetBulge mypoly1 3 tmp)[/QUOTE] [QUOTE] (vla-SetBulge mypoly1 5 tmp)[/QUOTE] [QUOTE] (vla-SetBulge mypoly1 7 tmp)[/QUOTE] [QUOTE] (setq despt (getpoint "\nSelect a point to place the profile:"))[/QUOTE] [QUOTE] (vla-move mypoly (listtovariantArray (list 0.0 0.0 0.0)) (listtovariantArray despt))[/QUOTE] [QUOTE] (vla-move mypoly1 (listtovariantArray (list 0.0 0.0 0.0)) (listtovariantArray despt))[/QUOTE] [QUOTE] ; (vla-offset mypoly tt) [/QUOTE] [QUOTE] (vlax-release-object mspace)[/QUOTE] [QUOTE] (vlax-release-object acadDocument)[/QUOTE] [QUOTE] (vlax-release-object acadObject)[/QUOTE] [QUOTE] )[/QUOTE]