- 加了一行已经不会少一点了,只是希望楼主能够完善,比如重画出的线宽、高程、颜色等要和原来的一致,画完线还要把原来的线删掉
- defun c:ee () ;任意曲线变多段线一般只用于椭圆;圆弧和样条曲线
- (VL-LOAD-COM)(setvar "cmdecho" 0)
- (setq ss (ssget '((0 . "ARC,SPLINE,ELLIPSE,*POLYLINE"))))
- (setq lenss (sslength ss)
- i 0 eelist '()
- )
- (repeat lenss;外循环开始
- (setq en (ssname ss i);取得图元名
- obj (vlax-ename->vla-object en);转换为vla对象
- )
- (setq wide(vla-get-ConstantWidth obj))
- (setvar "PLINEWID" WIDE)
- (setq zc (vlax-curve-getdistatparam
- obj
- (vlax-curve-getendparam obj)
- );求得图元周长
- ;;;或者(setq zc(vlax-curve-getDistAtPoint obj (vlax-curve-getEndPoint obj)))
- )
- (setq j(- zc (fix zc)));取出周长的小数值
- (setq lst1(vlax-curve-getPointAtDist obj 0));取开始点
- (repeat (fix zc);循环周长取整次刚好到端点
- (setq lst (vlax-curve-getPointAtDist obj j);取距开始点为j的点
- lstlen (vlax-curve-getDistAtPoint obj lst);测量开始点到j点的距离
- )
- (setq
- eelist (append eelist (list (list (nth 0 lst) (nth 1 lst))));加入到点集
- )
- (setq j (1+ j));递增1
- );内循环结束
- ;(setq eelist(reverse eelist))
- (setq lst2(vlax-curve-getEndPoint obj))
- (setq
- eelist (append eelist (list (list (nth 0 lst2) (nth 1 lst2))));加入到点集
- )
- (command ".pline" "non" lst1);开始描点
- (foreach n eelist (command "non" n)(grdraw lst1 n 1) (setq lst1 n));模拟描红
- (COMMAND "" );描点结束
- (setq eelist '());清空点集
- (setq i (1+ i));下一个图元
- );外循环结束
- (princ)(princ)
- )
|