样条曲线的连接问题

wmz

请教:我要把两根或多根首尾靠近的样条曲线连接起来,该如何做呢?就像多段线的PEDIT命令的J选项一样?

BDYCAD

Look a Look

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=13129

 

 

BDYCAD

 

(vl-load-com) ;_ 确保加?了 activex 支持

;;; c:ccc
;;; 将相今的两条曲线合并成一条曲线，
;;; 同时如果一条曲线的两端点相邻则将此曲线封闭。
;;; 用户可手工选择两曲线（spline,*polyline），或一条曲线，先选后选均可。
(defun c:ccc (/     comclosedist fpprecision  selsets
       selset    filtertype filterdata   curve1
       fplist1    curve2 fplist2      fparray
       statan    endtan newcurve     newcurvearray
      )
  (setq *thisdrawing* (vla-get-activedocument (vlax-get-acad-object))
 *modelspace*  (vla-get-ModelSpace *thisdrawing*)
  )
  (setq comclosedist 10 ;_ 小于这个距离才合并或封闭
 fpprecision 1.01 ;_ ?取 fitpoint ?使用的精度
 filtertype 0 ;_ 0 在DXF格式中是 图元类型的组码
 filterdata "spline,*polyline" ;_ 图元类型的值
 newcurve nil
  )
  ;; 曲线选择,一条或两条
  (setq selsets (ssget '((0 . "SPLINE,*POLYLINE"))))
  ;|(setq selsets (vla-get-selectionsets *thisdrawing*))
  (if (= (vla-get-count selsets) 0)
    (vla-add selsets (vlax-make-variant "ss1"))
  )
  (vla-update selset)
  (setq selset (vla-item selsets 0))
  (vla-clear selset)
;;;  (vla-select  selset  acSelectionSetPrevious filtertype  filterdata)
  (if (= 0 (vla-get-count selset))
    (progn
      (prompt"\n请选择两条相邻的 spline,*polyline <退出>:")
      ; (vla-SelectOnScreen selset filtertype filterdata)
      (vla-SelectOnScreen selset)
    )
  )|;
  ;; 进行曲线合并
  (if (= 2 (SSLENGTH selsets));(= 2 (vla-get-count selset))
    (progn
      ;; 选取第1条曲线的合点列表 fitpoints 。
      ;;;(setq curve1 (vla-item selset 0))
      (setq curve1 (VLAX-ENAME->VLA-OBJECT (SSNAME selsets 0 ))); (vla-item selset 0))
      (if (= "acdbspline" (strcase (vla-get-ObjectName curve1) t))
 (setq fplist1 (spline_fplist curve1 fpprecision)) ;_ 对 spline ，直接或?接取它的 fitpoint 。
 (setq fplist1 (pline_vertexlist curve1)) ;_ 对 *polyline ，取其 vertex 为 fitpoint 。
      )
      ;; 选取第2条曲线的合点列表 fitpoints 。
      ;;;(setq curve2 (vla-item selset 1))
      (setq curve2 (VLAX-ENAME->VLA-OBJECT (SSNAME selsets 1)))
      (if (= "acdbspline" (strcase (vla-get-ObjectName curve2) t))
 (setq fplist2 (spline_fplist curve2 fpprecision)) ;_ ? spline ，直接或?接取它的 fitpoint 。
 (setq fplist2 (pline_vertexlist curve2)) ;_ ? *polyline ，取其 vertex ? fitpoint 。
      )
      ;;删除曲线
      (vla-delete curve1)
      (vla-delete curve2)
      ;; 合并点表fplist生成新曲线
      (setq fplist1 (spline_combine2fpl fplist1 fplist2))
      (setq fparray (vlax-make-safearray
        vlax-vbdouble
        (cons 0 (1- (length fplist1)))
      )
      )
      (vlax-safearray-fill fparray fplist1)
      (setq
 statan (setq
   endtan (vlax-make-safearray vlax-vbDouble '(0 . 2))
        )
      )
      (setq newcurve (vla-addspline *modelspace* fparray statan endtan))
      ;; ?新曲?的 fitpoint 都 purge 掉，以?少?形?据量。
;;;      (vla-PurgeFitData newcurve)
      ;; ?曲?加入 selset ，以供?一步?理
      (vla-clear selset)
      (setq newcurvearray (vlax-make-safearray vlax-vbObject '(0 . 0)))
      (vlax-safearray-fill newcurvearray (list newcurve))
      (vla-additems selset newcurvearray)
    )
  )
  ;; ?曲?封?
  (if (= 1 (vla-get-count selset))
    (progn
      (setq newcurve (vla-item selset 0))
      (if (> comclosedist
      (distance (vlax-curve-getstartpoint newcurve)
         (vlax-curve-getEndPoint newcurve)
      )
   )
 (progn
   ;; 用 ssadd ?建的 selection set , 才适用于命令行。
   ;; selset 的?型是 VLA-Object acadSelectionSet , 不适用于命令行。
   ;; ?种??集不能互相??：(vlax-vla-object->ename selset) 返回 nil 。
   (setq lspselset (ssadd (vlax-vla-object->ename newcurve)))
   ;; ?用acad命令行
   (command "splinedit" lspselset "c" "" "")
 )
      )
    )
  )
  ;; ?束
  (princ)
)

;;; 返回 *polyline 的??（vertex）列表
;;; ???明，
;;; plobj -- polyline object , ?型? vla-object .
;;; -----
(defun pline_vertexlist
       (plobj / plname vtxlist fp fplist plinetype vtxcount i)
  (setq plname (vlax-vla-object->ename plobj)
 fplist nil
 i      0
  )
  (setq vtxlist (vlax-safearray->list (vla-get-coordinates plobj)))
  (setq plinetype (strcase (vla-get-objectname plobj) t))
  (cond
    ((= "acdblwpolyline" plinetype) ;_ ?? vtxlist 是 x,y 坐?
     (progn
       (setq vtxcount (/ (length vtxlist) 2))
       (repeat vtxcount
  (setq
    fp (trans (list (nth i vtxlist) (nth (+ i 2) vtxlist) 0)
       plname
       0
       )
  ) ;_ 同???的坐?? ocs ??? wcs
  (setq fplist (cons fp fplist))
  (setq i (+ i 2))
       )
     )
    )
    ((= "acdbpolyline" plinetype) ;_ ?? vtxlist 是 x,y,z 坐?
     (progn
       (setq vtxcount (/ (length vtxlist) 3))
       (repeat vtxcount
  (setq fp (trans (list (nth i vtxlist)
          (nth (+ i 2) vtxlist)
          (nth (+ i 3) vtxlist)
    )
    plname
    0
    )
  ) ;_ 同???的坐?? ocs ??? wcs
  (setq fplist (cons fp fplist))
  (setq i (+ i 3))
       )
     )
    )
  )
  fplist ;_ 返回值
) ;_ pline_vertexlist ?束

;;; 返回 spline 的?合?（fitpoint）列表
;;; ???明，
;;; splobj -- spline object , ?型? vla-object .
;;; precision -- ?取 fitpoint ?的精确度。相?? fitpoint ?曲?分段。
;;;              分段?端?的曲??度与直接距离相比，比值不大于 precision 。
;;; 算法?明，
;;; ??曲??度增加，?算量也?性增加。
;;; -----
(defun spline_fplist (splobj      precision     /
        list_fps  ; list of fitpoints
        len_fps  ; length of the curve coverd by the fipoint list
        wcslist_rmsegs ; end wcs list of remaining segments
        lenlist_rmsegs ; length list of remaining segments
        fpwcs_segsta ; fitpoint WCS of the current segment start
        fpwcs_segend ; fitpoint WCS of the current segment end
        per_seg  ; percent of the curve coverd by the current segment, ex, 0.5, 0.25, ...
        len_seg  ; length of current segment
        dist_seg  ; distance between the current segment's two ends
        acprecision ; actual precision
        wcs_sta  ; wcs of the curve's start point
        wcs_end  ; wcs of the curve's end point
       )
  ;; 防止精度不合理
  ;; 太高精度?死机或引起超?值域等??。
  (if (< precision 1.005)
    (setq precision 1.005)
  )
  ;; 初始化
  (setq list_fps (cons (vlax-curve-getstartPoint splobj) nil)) ;_ ?起?坐?加到 fitpoint 列表中
  (setq len_fps 0.0) ;_ list_fps 的覆??度? 0.0
  (setq wcslist_rmsegs (cons (vlax-curve-getendPoint splobj) nil)) ;_ ???坐?加到 剩余段??列表
  (setq lenlist_rmsegs
  (cons (vlax-curve-getDistAtParam
   splobj
   (vlax-curve-getEndParam splobj)
        )
        nil
  )
  ) ;_ ?曲?全?加到 剩余段??列表
  ;; ?取 list_fps
  (while (/= wcslist_rmsegs nil) ;_ ?list_fps未覆?整?曲????
    ;;
    (setq len_seg (car lenlist_rmsegs))
    (setq fpwcs_segsta (car list_fps))
    (setq fpwcs_segend (car wcslist_rmsegs))
    (setq dist_seg (distance fpwcs_segsta fpwcs_segend))
    (setq acprecision
    (/ len_seg dist_seg))
    (if (> precision acprecision)
      ;; 精度?到要求?
      (progn
 (setq list_fps (cons fpwcs_segend list_fps)) ;_ fitpoint 列表增加一??
 (setq len_fps (+ len_fps len_seg)) ;_ fitpoint 覆?的?度增加
 (setq lenlist_rmsegs (cdr lenlist_rmsegs)) ;_ 剩余段列表?少一段
 (setq wcslist_rmsegs (cdr wcslist_rmsegs))
      )
      ;; 精度不足?
      (progn
 (setq len_seg (/ len_seg 2)) ;_ ??前的段一分? 2
 (setq lenlist_rmsegs
        (cons len_seg (cons len_seg (cdr lenlist_rmsegs)))
 ) ;_ 剩余段列表第一段???段
 (setq wcslist_rmsegs
        (cons
   (vlax-curve-getPointAtDist splobj (+ len_fps len_seg))
   wcslist_rmsegs
        )
 ) ;_ 剩余段??增加一?

      )
    )
  )
  list_fps ;_ 返回值
) ;_ spline_fplist ?束

;;; 返回?? spline ?合?列表的合并列表
;;; Combine two FitPoint Lists .
(defun spline_combine2fpl (fpl1 fpl2 / rev1 rev2 mdist ndist fpcount i)
  ;; 判?最?近的端?，并?定是否要??合?列表返序
  ;; 第1次
  (setq rev1  nil ;_ fpl1 不需反序
 rev2  nil ;_ fpl2 不需反序
 mdist (distance (last fpl1) (car fpl2)) ;_ 最?近的端?的距离
  )
  ;; 第2次
  (setq ndist (distance (last fpl1) (last fpl2)))
  (if (> mdist ndist)
    (setq rev1 nil
   rev2 1
   mdist ndist
    )
  )
  ;; 第3次
  (setq ndist (distance (car fpl1) (car fpl2)))
  (if (> mdist ndist)
    (setq rev1 1
   rev2 nil
   mdist ndist
    )
  )
  ;; 第4次
  (setq ndist (distance (car fpl1) (last fpl2)))
  (if (> mdist ndist)
    (setq rev1 1
   rev2 1
   mdist ndist
    )
  )
  ;; 完成???合?列表合并
  (if rev1
    (setq fpl1 (reverse fpl1))
  )
  (if rev2
    (setq fpl2 (reverse fpl2))
  )
  (setq fpl1 (append fpl1 fpl2)
 fpl2 nil
 fpcount (length fpl1)
 i 0
  )
  (repeat fpcount
    (setq fpl2 (append fpl2 (nth i fpl1)))
    (setq i (+ 1 i))
  )
  fpl2
)

wmz

太感谢了!只是程序运行时出现一个错误:"错误: 参数类型错误: VLA-OBJECT",但曲线还是连接了,不知何故?

Ea

AutoCAD 2006 -〉Join

wmz

可我现在用的是AutoCAD2004呀!我临时写了一个简单、有限制条件(即创建样条曲线时必须向一个方向)但能解决我的问题的程序,请指教:

;;取样条曲线坐标函数
(defun Ytqx(s1 / n0 s2 p0 p1)
      (setq s2 (entget s1))
      (setq p1 (member (assoc 11 s2) s2))
      (setq  n (length p1) n0 0)
  (repeat n
 (setq p0 (cdr (nth n0 p1))
        p (append p (list p0))
       n0 (+ n0 1)
 )     
  )
)

 

;;样条曲线连接
(defun c:YTLJ(/ s s1 n0 n1 nn m p1 B PXB)
     (prompt "选择样条曲线:")
     (setq s (ssget '((0 . "spline"))))
  (if s
    (progn
     (setq nn (sslength s) m 0 n0 0 s1 nil PXB (list))
     (repeat nn
           (setq s1 (ssname s m) n 0 n1 0 p (list) B (list))
           (ytqx s1)
           (setq B (reverse p))
           (setq PXB (append PXB B))
           (command "erase" s1 "")
       (setq m (+ m 1) n0 (+ n0 n))
     )
       (setq n1 0)
       (command "spline")
     (repeat n0
           (setq p1 (nth n1 PXB))
           (command p1)
       (setq n1 (+ n1 1))
     ) 
     (command "" "" "")
     (princ)
    )
  )
)