[原创]曲线圆滑拟合2条样条曲线

gao6690

程序如下(vl-load-com)
(defun c:tc (/ IsCurve ent1 ent2 pt1 pt2 p11 p12 p21 p22 start end obj1 obj2
                                                                                 osmode
                                                                )                                                                                                                                                 ; Check an entity is a curve or not
                (defun IsCurve (ename / name)
                                (if ename
                                                (progn
                                (setq name (cdr (assoc 0 (entget ename))))
                                (cond
                                                ((= name "LWPOLYLINE")
                                                                T
                                                )
                                                ((= name "pOLYLINE")
                                                                T
                                                )
                                                ((= name "CIRCLE")
                                                                T
                                                )
                                                ((= name "ARC")
                                                                T
                                                )
                                                ((= name "LINE")
                                                                T
                                                )
                                                ((= name "ELLIPSE")
                                                                T
                                                )
                                                ((= name "SPLINE")
                                                                T
                                                )
                                                (T
                                                                NIL
                                                )
                                )
                                                )
                                                NIL
                                )
                )

                ;; Main Program
                (setvar "cmdecho" 0)
                (vl-cmdf "_.undo" "g")
                (setq osmode (getvar "osmode"))
                (setvar "osmode" 0)
                (setq ent1 (entsel "选择第一条曲线："))
                (if (IsCurve (car ent1))
                                (progn
                                                (if (IsCurve (car (setq ent2 (entsel "\n选择第二条曲线："))))
                                (progn
                                                (setq pt1 (cadr ent1)
                                                                obj1 (vlax-ename->vla-object (car ent1))
                                                                pt2 (cadr ent2)
                                                                obj2 (vlax-ename->vla-object (car ent2))
                                                )
                                                (setq start (vlax-curve-getstartpoint obj1)
                                                                end (vlax-curve-getendpoint obj1)
                                                )
                                                (if (< (distance start pt1) (distance end pt1))
                                                                (setq p11 start
                                                                                p12 (vlax-curve-getfirstderiv obj1
                                                                                                                                                                                                (vlax-curve-getstartparam obj1)
                                                                                                                )
                                                                                p12 (mapcar
                                                                                                '+
                                                                                                p11
                                                                                                p12
                                                                                                                )
                                                                )
                                                                (setq p11 end
                                                                                p12 (vlax-curve-getfirstderiv obj1
                                                                                                                                                                                                (vlax-curve-getendparam obj1)
                                                                                                                )
                                                                                p12 (mapcar
                                                                                                '-
                                                                                                p11
                                                                                                p12
                                                                                                                )
                                                                )
                                                )
                                                (setq start (vlax-curve-getstartpoint obj2)
                                                                end (vlax-curve-getendpoint obj2)
                                                )
                                                (if (< (distance start pt2) (distance end pt2))
                                                                (setq p21 start
                                                                                p22 (vlax-curve-getfirstderiv obj2
                                                                                                                                                                                                (vlax-curve-getstartparam obj2)
                                                                                                                )
                                                                                p22 (mapcar
                                                                                                '+
                                                                                                p21
                                                                                                p22
                                                                                                                )
                                                                )
                                                                (setq p21 end
                                                                                p22 (vlax-curve-getfirstderiv obj2
                                                                                                                                                                                                (vlax-curve-getendparam obj2)
                                                                                                                )
                                                                                p22 (mapcar
                                                                                                '-
                                                                                                p21
                                                                                                p22
                                                                                                                )
                                                                )
                                                )
                                                (vl-cmdf "_.spline" p11 p21 "" p12 p22)
                                )
                                                )
                                )
                )
                (setvar "osmode" osmode)
                (vl-cmdf "_.undo" "e")
)

766697417

请问如何使用

crazylsp

很好用谢谢提供

yoyoho

感谢楼主分享程序!

隽轩2013

cad自带blend功能 结果一模一样

阿猪蛋

很好用谢谢提供