样条曲线转多段线lisp.doc

(完整word)样条曲线转多段线lisp
;;；下载此文档后，将所有文字复制到文本文档保存，再将文本文档的后缀txt更改为lsp，启动CAD后加载此文件即可使用
(princ ”加载程序成功，输入s2p命令可应用此工具\n”)
；；;***样条曲线转多段线 程序开始＊＊＊

(defun spline—to-pline (/ i)
(vl—load-com）
（setq ＊thisdrawing* （vla-get—activedocument
（vlax—get-acad—object）
） ;_ end of vla-get-activedocument
*modelspace＊ （vla—get-ModelSpace *thisdrawing*)
） ;_ end of setq
(setq spline-list （get—spline)）
（setq i （— 1））
(if spline—list
(progn
(setq msg "\nNumber of segments <100〉： ")
（initget 6)
(setq num （getint msg)）
（if (or （= num 100） （= num nil）)
(setq num 100）
） ；_ end of if
(repeat (length spline-list）
(setq splobj （nth (setq i （1+ i）) spline—list))
(convert-spline splobj num)
） ；_ end of repeat
) ;_ end of progn
） ；_ end of if
) ；_ end of spline—to-pline

(defun get—spline （/ spl—list obj spline no—ent i）
(setq spl—list nil
obj nil
spline "AcDbSpline"
selsets （vla-get-selectionsets ＊thisdrawing*）
ss1 （vlax-make—variant ”ss1”）
） ；_ end of setq
(if (= （vla-get—count selsets) 0）
(setq ssobj （vla—add selsets ss1))
) ;_ end of if
(vla—clear ssobj）
（setq no—ent 1)
(while no-ent
（prompt "\nSelect splines： ”)
(vla—Selectonscreen ssobj)
(if (> （vla-get—count ssobj） 0)
(progn
（setq no—ent nil）
（setq i (- 1))
（repeat (vla-get—count ssobj）
(setq
obj (vla-item ssobj
(vlax—make-variant （setq i (1+ i）)）
) ;_ end of vla—item
) ;_ end of setq
（cond
（（= (vlax-get—property obj "ObjectName"） spline)
（setq spl-list
(append spl—list (list obj))
） ;_ end of setq
)
） ;_ end-of cond
) ;_ end of repeat
） ;_ end of progn
(prompt ”\nNo entities selected， try again.”）
) ；_ end of if
（if （and （= nil no-ent) (= nil spl—list））
（progn
（setq no—ent 1）
(prompt ”\nNo splines selected。"）
(quit）
） ;_ end of progn
) ；_ end of if
） ;_ end of while
(vla—delete (vla-item selsets 0)）
spl—list
） ;_ end of get—spline

(defun convert—spline （splobj n / i）
（setq point—list nil
2Dpoint—list nil
z—list nil
spl-lyr (vlax—get—property splobj 'Layer)
startSpline (vlax—curve—getStartParam splobj)
endSpline (vlax-curve—getEndParam splobj)
i （- 1）
） ;_ end of setq
（repeat (+ n 1）
(setq i （1+ i））
(setq p （vlax-curve-getPointAtParam
splobj
（* i
(/ (— endspline startspline) n）
） ；_ end of ＊
） ；_ end of vlax-curve—getPointAtParam
） ；_ end of setq
（setq 2Dp （list (car p） （cadr p))
2Dpoint—list (append 2Dpoint—list 2Dp)
point-list (append point—list p）
z (caddr p)
z-list （append z—list (list z)）
) ；_ end of setq
) ；_ end of repeat
（setq summ （apply ’+ z-list）)
(setq arraySpace
(vlax-make—safearray
vlax—vbdouble ; element type
(cons 0
(— （length point-list) 1）
) ； array dimension
) ;_ end of vlax-make-safearray
) ;_ end of setq
(setq vert—array (vlax—safearray-fill arraySpace point-list））
(vlax-make-variant vert—array）
（if (and (= ：vlax-true (vlax—get—property splobj 'IsPLanar)）
(= summ 0。0)
） ；_ end of and
(setq plobj （add-polyline
2Dpoint—list
vla—AddLightweightPolyline
） ;_ end of add—polyline
) ；_ end of setq
(setq plobj (add-polyline
point—list
vla-Add3DPoly
) ;_ end of add-polyline
） ;_ end of setq
） ;_ end of if
（vlax—put—property plobj 'Layer spl-lyr）
（vla—delete splobj)
（vlax—release—object splobj）
) ；_ end of convert-spline

（defun add-polyline (pt-list poly—func)
(setq arraySpace
（vlax—make—safearray
vlax—vbdouble
（cons 0
(— （length pt-list) 1)
） ; array dimension
） ；_ end of vlax-make-safearray
） ;_ end of setq
(setq vertex—array
（vlax—safearray-fill arraySpace pt-list）
) ;_ end of setq
（vlax-make-variant vertex—array）
（setq plobj （poly-func
＊modelspace＊
vertex-array
) ;_ end of poly-func
） ;_ end of setq
） ;_ end of add-polyline

（defun c:s2p （)
(spline-to-pline)
(princ）
） ；_ end of c:s2p

；；;*＊*样条曲线转多段线 程序结束＊＊＊