[分享]：spline->pl的高效代码

wkai · 发表于 2004-1-7 09:32:18

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

:2204.12.11.23.58
下面的代码有些漏洞，在25楼有完善过的代码~
aro斑竹在23楼的代码也非常好~

这是我刚刚写完的一段将spline转换为pl的代码，主函数通过对自身的递归调用，求出满足拟合精度的顶点表。
当然也可以用于圆弧，圆，椭圆弧，椭圆，带圆弧的复义线，spline化的复义线转换为全部直线段的复义线。

转贴请注明出处，谢谢 [/COLOR]

[FONT=courier new];__2004.01.08.08.27_____________________________________
;__样条曲线--〉复义线___BY__WKAI__晓东CAD论坛___________
(defun c:tt (/ pts min_distacne vlo st_par ed_par ent n )
(setq vlo (vlax-ename->vla-object (setq ent (car (entsel "\n选择spline："))))
st_par (vlax-curve-getstartparam vlo)
ed_par (vlax-curve-getendparam vlo)
pts (list (vlax-curve-getstartpoint vlo))
min_distacne (/ (vlax-curve-getdistatparam vlo ed_par) 1000.0)
;;;_拟合精度，即拟合复义线与spline的最大距离。默认为spline长度的千分一
n 0
)
(t1 vlo st_par ed_par)
(command "pline")(foreach n pts(command n))(command)
(princ (strcat "\n创建一条顶点数为" (itoa(length pts))"的复义线。"))(princ)
)
;________________________________________________________
;________________________________________________________
(defun t1 (vl_obj start_par end_par / dis_m_m ed_p ed_pt mid_p mid_pt mid_pt_vlo st_p st_pt)
(setq st_p start_par
ed_p end_par
st_pt (vlax-curve-getpointatparam vl_obj st_p)
ed_pt (if (vlax-curve-getpointatparam vl_obj ed_p)
(vlax-curve-getpointatparam vl_obj ed_p)
(vlax-curve-getendpoint vl_obj)
)
mid_pt (mapcar '(lambda (x y) (/ (+ x y) 2.0)) st_pt ed_pt)
mid_pt_vlo (vlax-curve-getpointatparam vl_obj (/ (+ st_p ed_p) 2.0))
mid_p (vlax-curve-getparamatpoint vl_obj mid_pt_vlo)
dis_m_m (distance mid_pt_vlo mid_pt)
)
(if (> dis_m_m min_distacne)
(progn
(t1 vl_obj st_p mid_p)
(t1 vl_obj mid_p ed_p)
)
(setq pts (append pts (list mid_pt_vlo) (list ed_pt)))
)
)
;________________________________________________________
;________________________________________________________
(princ "\n样条曲线--〉复义线___BY__WKAI__晓东CAD论坛") [/FONT]

[FONT=courier new];__2004.01.08.08.27_____________________________________ 
;__样条曲线--〉复义线___BY__WKAI__晓东CAD论坛___________ 
(defun c:tt (/ pts min_distacne vlo st_par ed_par ent n ) 
  (setq        vlo             (vlax-ename->vla-object (setq ent (car (entsel "\n选择spline：")))) 
        st_par             (vlax-curve-getstartparam vlo) 
        ed_par             (vlax-curve-getendparam vlo) 
        pts             (list (vlax-curve-getstartpoint vlo)) 
        min_distacne (/ (vlax-curve-getdistatparam vlo ed_par) 1000.0) 
        ;;;_拟合精度，即拟合复义线与spline的最大距离。默认为spline长度的千分一 
        n            0 
        ) 
  (t1 vlo st_par ed_par) 
  (command "pline")(foreach n pts(command n))(command) 
  (princ (strcat "\n创建一条顶点数为" (itoa(length pts))"的复义线。"))(princ) 
) 
;________________________________________________________ 
;________________________________________________________ 
(defun t1 (vl_obj start_par end_par / dis_m_m ed_p ed_pt mid_p mid_pt mid_pt_vlo st_p st_pt) 
  (setq        st_p           start_par 
        ed_p           end_par 
        st_pt           (vlax-curve-getpointatparam vl_obj st_p) 
        ed_pt           (if (vlax-curve-getpointatparam vl_obj ed_p) 
                     (vlax-curve-getpointatparam vl_obj ed_p) 
                     (vlax-curve-getendpoint vl_obj) 
                   ) 
        mid_pt           (mapcar '(lambda (x y) (/ (+ x y) 2.0)) st_pt ed_pt) 
        mid_pt_vlo (vlax-curve-getpointatparam vl_obj (/ (+ st_p ed_p) 2.0)) 
        mid_p           (vlax-curve-getparamatpoint vl_obj mid_pt_vlo) 
        dis_m_m           (distance mid_pt_vlo mid_pt) 
  ) 
  (if (> dis_m_m min_distacne) 
    (progn 
      (t1 vl_obj st_p mid_p) 
      (t1 vl_obj mid_p ed_p) 
    ) 
    (setq pts (append pts (list mid_pt_vlo) (list ed_pt))) 
  ) 
) 
;________________________________________________________ 
;________________________________________________________ 
(princ "\n样条曲线--〉复义线___BY__WKAI__晓东CAD论坛")  [/FONT]

eachy · 发表于 2004-1-7 10:05:07

是否增加一个 (equal dis_m_m min_distacne 0.001) 就可以处理近似直线部分的 Spline 或者含弧段的 Pline。

wkai · 发表于 2004-1-7 10:23:00

本来就可以用于 "近似直线部分的 Spline 或者含弧段的 Pline" 呀~

这段代码关于递归的算法有BUG，还没搞清楚问题所在
：|

aeo · 发表于 2004-1-8 02:24:01

给你把问题搞复杂了吧.干吗还用递归?递归并不高效.
eachy不是写过吗.

wkai · 发表于 2004-1-8 07:57:04

已经改好了~
:)

另，我没有搜到eachy斑竹的程序，给点线索好么?

LUCAS · 发表于 2004-1-8 12:47:46

转换为全部弧线段的复义线效果會比較好

wkai · 发表于 2004-1-8 13:42:27

最初由 LUCAS 发布
[B]转换为全部弧线段的复义线效果會比較好 [/B]

有没有相关代码？
学习学习~

LUCAS · 发表于 2004-1-8 16:19:43

我也貼一種別類的方法,它不用設精度,,程式未優化不便公開s2p.fas簡體版(for spline & ellipse to pline)

把你的PTS兩點中加一點(曲線上中間點),再利用PLINE指令畫出即可
從以下就知道有多簡單!!

指令: _pline
指定起點:
目前的線寬是 0.0000
指定下一點或 [弧(A)/半寬(H)/長度(L)/復原(U)/寬度(W)]: A

輸入弧終點選項或
[角度(A)/中心點(CE)/方向(D)/半寬(H)/直線(L)/半徑(R)/第二點(S)/復原(U)/寬度(W)]:
S

指定弧的第二點:
指定弧的終點:
指定弧的終點或
[角度(A)/中心點(CE)/閉合(CL)/方向(D)/半寬(H)/直線(L)/半徑(R)/第二點(S)/復原(U)/
寬度(W)]: S

指定弧的第二點:
指定弧的終點:
指定弧的終點或
[角度(A)/中心點(CE)/閉合(CL)/方向(D)/半寬(H)/直線(L)/半徑(R)/第二點(S)/復原(U)/
寬度(W)]:

陌生人 · 发表于 2004-1-8 21:02:51

传的程序没提示，和你帖子说的不一样，但是已经达到部分转换优化的目的了，只是曲度大处点还多了些

LUCAS · 发表于 2004-1-9 07:51:29

最初由 wkai 发布
[B]

有没有相关代码？
学习学习~ [/B]

;;__2004.01.08.08.27_____________________________________
;;__样条曲线--〉复义线___BY__WKAI__晓东CAD论坛___________
;;Modify BY LUCAS
(defun C:TT (/ PTS MIN_DISTACNE VLO ST_PAR ED_PAR ENT N LEN)
(setq VLO (vlax-ename->vla-object
(setq ENT (car (entsel "\n选择Spline,Ellipse,Arc,Circle: ")))
)
ST_PAR (vlax-curve-getstartparam VLO)
ED_PAR (vlax-curve-getendparam VLO)
PTS (list (vlax-curve-getstartpoint VLO))
MIN_DISTACNE (/ (vlax-curve-getdistatparam VLO ED_PAR) 2000.0)
; 1000→2000 BY LUCAS
;;;_拟合精度，即拟合复义线与spline的最大距离。默认为spline长度的千分一
N 0
)
(T1 VLO ST_PAR ED_PAR)
;;BY LUCAS
;;------------------------------------
(command "_.PLINE" (nth 0 PTS) "A")
(setq N 1
LEN (/ (length PTS) 2)
)
(repeat LEN
(command "S" (nth N PTS) (nth (1+ N) PTS))
(setq N (+ N 2))
)
(command "")
;;-------------------------------------
;|
(command "pline")
(foreach N PTS (command N))
(command)
|;
(princ (strcat "\n创建一条顶点数为"
(itoa LEN)
"的复义线。"
)
)
(princ)
)
;;________________________________________________________
;;________________________________________________________
(defun T1 (VL_OBJ START_PAR END_PAR / DIS_M_M ED_P
ED_PT MID_P MID_PT MID_PT_VLO ST_P
ST_PT
)
(setq ST_P START_PAR
ED_P END_PAR
ST_PT (vlax-curve-getpointatparam VL_OBJ ST_P)
ED_PT (if (vlax-curve-getpointatparam VL_OBJ ED_P)
(vlax-curve-getpointatparam VL_OBJ ED_P)
(vlax-curve-getendpoint VL_OBJ)
)
MID_PT (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) ST_PT ED_PT)
MID_PT_VLO (vlax-curve-getpointatparam VL_OBJ (/ (+ ST_P ED_P) 2.0))
MID_P (vlax-curve-getparamatpoint VL_OBJ MID_PT_VLO)
DIS_M_M (distance MID_PT_VLO MID_PT)
)
(if (> DIS_M_M MIN_DISTACNE)
(progn
(T1 VL_OBJ ST_P MID_P)
(T1 VL_OBJ MID_P ED_P)
)
(setq PTS (append PTS (list MID_PT_VLO) (list ED_PT)))
)
)
;;________________________________________________________
;;________________________________________________________
(princ "\n样条曲线--〉复义线___BY__WKAI__晓东CAD论坛")

;;__2004.01.08.08.27_____________________________________ 
;;__样条曲线--〉复义线___BY__WKAI__晓东CAD论坛___________ 
;;Modify BY LUCAS 
(defun C:TT (/ PTS MIN_DISTACNE VLO ST_PAR ED_PAR ENT N LEN) 
  (setq        VLO             (vlax-ename->vla-object 
                       (setq ENT (car (entsel "\n选择Spline,Ellipse,Arc,Circle: "))) 
                     ) 
        ST_PAR             (vlax-curve-getstartparam VLO) 
        ED_PAR             (vlax-curve-getendparam VLO) 
        PTS             (list (vlax-curve-getstartpoint VLO)) 
        MIN_DISTACNE (/ (vlax-curve-getdistatparam VLO ED_PAR) 2000.0) 
                                        ; 1000→2000 BY LUCAS 
;;;_拟合精度，即拟合复义线与spline的最大距离。默认为spline长度的千分一 
        N             0 
  ) 
  (T1 VLO ST_PAR ED_PAR) 
 
  ;;BY LUCAS 
  ;;------------------------------------ 
  (command "_.PLINE" (nth 0 PTS) "A") 
  (setq        N   1 
        LEN (/ (length PTS) 2) 
  ) 
  (repeat LEN 
    (command "S" (nth N PTS) (nth (1+ N) PTS)) 
    (setq N (+ N 2)) 
  ) 
  (command "") 
  ;;------------------------------------- 
 
  ;| 
  (command "pline") 
  (foreach N PTS (command N)) 
  (command) 
  |; 
 
  (princ (strcat "\n创建一条顶点数为" 
                 (itoa LEN) 
                 "的复义线。" 
         ) 
  ) 
  (princ) 
) 
;;________________________________________________________ 
;;________________________________________________________ 
(defun T1 (VL_OBJ    START_PAR END_PAR         /           DIS_M_M   ED_P 
           ED_PT     MID_P     MID_PT         MID_PT_VLO             ST_P 
           ST_PT 
          ) 
  (setq        ST_P           START_PAR 
        ED_P           END_PAR 
        ST_PT           (vlax-curve-getpointatparam VL_OBJ ST_P) 
        ED_PT           (if (vlax-curve-getpointatparam VL_OBJ ED_P) 
                     (vlax-curve-getpointatparam VL_OBJ ED_P) 
                     (vlax-curve-getendpoint VL_OBJ) 
                   ) 
        MID_PT           (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) ST_PT ED_PT) 
        MID_PT_VLO (vlax-curve-getpointatparam VL_OBJ (/ (+ ST_P ED_P) 2.0)) 
        MID_P           (vlax-curve-getparamatpoint VL_OBJ MID_PT_VLO) 
        DIS_M_M           (distance MID_PT_VLO MID_PT) 
  ) 
  (if (> DIS_M_M MIN_DISTACNE) 
    (progn 
      (T1 VL_OBJ ST_P MID_P) 
      (T1 VL_OBJ MID_P ED_P) 
    ) 
    (setq PTS (append PTS (list MID_PT_VLO) (list ED_PT))) 
  ) 
) 
;;________________________________________________________ 
;;________________________________________________________ 
(princ "\n样条曲线--〉复义线___BY__WKAI__晓东CAD论坛")

wkai · 发表于 2004-1-9 10:03:27

跟我想的不一样，我以为你说用圆弧拟合是为了减少顶点数~

不过这样作也挺好，更加贴合原有曲线，~

lida2012 · 发表于 2004-1-9 10:39:20

俺是个新手，不知这些代码该如何插入？求教各位大大

aeo · 发表于 2004-1-10 00:41:19

不过cad自己的拟合过的pline线炸开是直线,那反过去也应该是直线吧.

其实看你们的意思无非是这样，写的简单点:

[php]
(defun C:TT ( / ed_par n pt vlo)
(setq VLO(vlax-ename->vla-object
(car(entsel "\n选择Spline,Ellipse: ")))
ED_PAR (vlax-curve-getendparam VLO)
PT (vlax-curve-getendpoint VLO)
n (/ ED_PAR 2000.0)
)
(command "_.PLINE" pt "a")
(repeat 1000
(command "S")
(repeat 2(command(vlax-curve-getpointatparam VLO(setq ED_PAR(- ED_PAR n)))))
)
(command "")
)
;;;如果光直线
(defun C:TT ( / ed_par n pt vlo)
(setq VLO(vlax-ename->vla-object
(car(entsel "\n选择Spline,Ellipse: ")))
ED_PAR (vlax-curve-getendparam VLO)
PT (vlax-curve-getendpoint VLO)
n (/ ED_PAR 1000.0)
)
(command "_.PLINE" pt )
(repeat 1000
(command(vlax-curve-getpointatparam VLO(setq ED_PAR(- ED_PAR n))))
)
(command "")
)
[/php]

[php] 
(defun C:TT ( / ed_par n pt vlo) 
  (setq        VLO(vlax-ename->vla-object 
             (car(entsel "\n选择Spline,Ellipse: "))) 
        ED_PAR             (vlax-curve-getendparam VLO) 
        PT             (vlax-curve-getendpoint VLO) 
        n            (/ ED_PAR 2000.0)                                
  ) 
  (command "_.PLINE" pt "a") 
  (repeat 1000 
    (command "S") 
    (repeat 2(command(vlax-curve-getpointatparam VLO(setq ED_PAR(- ED_PAR n))))) 
  ) 
  (command "") 
) 
 
 
 
 
 
;;;如果光直线 
(defun C:TT ( / ed_par n pt vlo) 
  (setq        VLO(vlax-ename->vla-object 
             (car(entsel "\n选择Spline,Ellipse: "))) 
        ED_PAR             (vlax-curve-getendparam VLO) 
        PT             (vlax-curve-getendpoint VLO) 
        n            (/ ED_PAR 1000.0)                                
  ) 
  (command "_.PLINE" pt ) 
  (repeat 1000 
    (command(vlax-curve-getpointatparam VLO(setq ED_PAR(- ED_PAR n)))) 
  ) 
  (command "") 
) 
 
[/php]

陌生人 · 发表于 2004-1-10 03:00:02

之所有要“复杂”，就是要“优化”。这个才是重点。
如果要简单，还有更简单的。

;另外一种方法

(defun tt2 (e)
(setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
obj (vlax-ename->vla-object e)
vlst (vla-get-controlpoints obj))
(vla-addpolyline mspace vlst)
)

测试: (tt2 (car(entsel)))

wkai · 发表于 2004-1-11 00:15:49

最初由 aeo 发布
[B]不过cad自己的拟合过的pline线炸开是直线,那反过去也应该是直线吧.
其实看你们的意思无非是这样，写的简单点:
[/B]

统统等分一千份的做法，对很短的曲线，尤其是很直的曲线是不是有点太过分了~

账号		自动登录	找回密码
密码			立即注册

[分享]：spline->pl的高效代码

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子