样条曲线可以传换成圆孤的吗

魔域狂龙

样条曲线可以传换成圆孤的吗。。怎样设置才可以。那位高手帮我写一个LISP程序。传换成圆孤不要太少。。孤长3。4MM都可以。。主要的是传换回的精度。圆孤要跟原来的样条曲线对得上。精度不能大于0。01MM。我在此先多谢先

21208804

问:::????vb中多义线如何拟合?

魔域狂龙

怎么没有帮帮我这个忙啊。。

在CAD里另存为R12格式可以把SPL传换回PL。但是传换过来都是直线了。是圆孤的地方也是直线。有什么办法可以把传换回来的PL有圆孤的地方是圆孤。直线的是直线。怎样设置或有什么程序可以的吗。

torcky

我以前编写过类似的程序但有点问题，另现在网吧不让上传

我把我的思路说一下吧，希望对你有所帮助：用vlax-curve-***函数获得spline的startpoint和endpoint，以及spline线上指定长度的点（我是将spline线等分n份；n越大精度越高run越慢）；然后循环在spline线上以三点画arc，直到完成。

几点注意：1.在比较尖锐的地方要缩小spline线上指定长度的点；2.当spline很平直时不能用arc只能用line；3.垂直和水平的spline部分要注意。

 

魔域狂龙

多谢楼上。。我对这个不懂啊。。能不能帮我帮到底。帮我写一个。在此先多谢先

HuaiYu

(defun c:t1 (/ en dist length-en nn vl-en vl-en old_osmode)
  (vl-load-com)
  (setq *acadobject*   (vlax-get-acad-object)
 *acaddocument* (vla-get-activedocument *acadobject*)
 *mspace*       (vla-get-modelspace *acaddocument*)
  ) ;_ endsetq

  (setq en (car (entsel "please select a spline: ")))
  (if (null en)
    (exit)
  ) ;_ endif
  (setq dist (getreal "please input the distance that you want: "))
  (if (null dist)
    (setq dist 1)
  ) ;_ endif
  (vla-startundomark *acadDocument*)
  (command "lengthen" en "")
  (setq ss1     (ssadd)
 old-osmode  (getvar "osmode")
 old-cmdecho (getvar "cmdecho")
 length-en   (getvar "perimeter")
 nn     (fix (/ length-en dist))
 i     0
 vl-en     (vlax-ename->vla-object en)
 c     (ssadd)
 pt-end     (cdr (last (entget en)))
  ) ;_ Endsetq
  (if (< length-en dist)
    (exit)
  ) ;_ Endif
  (setvar "osmode" 0)
  (setvar "cmdecho" 0)
  (repeat nn
    (setq pt0 (vlax-curve-getpointatdist vl-en (* (+ i 0) dist))
   pt1 (vlax-curve-getpointatdist vl-en (* (+ i 1) dist))
   i   (1+ i)
    ) ;_ Endsetq
    (command "line" pt0 pt1 "")
    (ssadd (entlast) ss1)
  ) ;_ Endrepeat
  (command "line" pt1 pt-end "")
  (command "pedit" (entlast) "y" "j" ss1 "" "")
  (setvar "osmode" old-osmode)
  (setvar "cmdecho" old-cmdecho)
  (vla-endundomark *acadDocument*)
) ;_ enddefun

HuaiYu

看能不能起一点抛砖引玉的作用了

，另请 torcky 批评指正

torcky

HuaiYu,你太谦虚了。

你是用短直线代替spline，这样还比较简单。

 

torcky

;;;这是俺好久以前写的，供各位参考

(defun c:cr ()
  (vl-load-com)
  (command "undo" "be")
  (command "ucs" "w")
  (setvar "cmdecho" 0)
  (setq oldpara1 (getvar "orthomode") oldpara2 (getvar "osmode"))
  (setvar "orthomode" 0 )
  (setvar  "osmode" 0)
  (setq entname (car(entsel "\nSelect Curve:")))
  (setq precision(getreal "\nEnter Precision Factor<1>:"))
  (command "area" "e" entname)
  (setq curve-long (getvar "perimeter"))
  (if (= precision nil)
    (setq facter 0.5)
    (setq facter (/ 0.5 precision)))
  (setq re (rem curve-long facter))
  (setq i (/ (- curve-long re)facter))
  (setq j 0)
  (setq arc (ssadd))
  (setq vla-curve(vlax-ename->vla-object entname))
  (setq st-point(vlax-curve-getStartPoint vla-curve))
  (while (< j i)
    (setq mid-point(vlax-curve-getPointAtDist vla-curve (+ (/ facter 2.0) (* facter j))))
    (setq end-point(vlax-curve-getPointAtDist vla-curve (+ facter (* facter j))))
    (slope)
    (cond
 ((= flags 0) (command "line" st-point end-point ""))
 ((= flags 1) (command "arc" st-point mid-point end-point))
 ((= flags 2) (progn
         (setq mid-point(vlax-curve-getPointAtDist vla-curve (+ (/ facter 8.0) (* facter j))))
                (setq end-point(vlax-curve-getPointAtDist vla-curve (+ (/ facter 4.0) (* facter j))))
         (command "arc" st-point mid-point end-point))))
    (setq arc (ssadd (entlast) arc))
    (setq st-point end-point)
    (setq j(1+ j))
    )
  (if (> re 0)
    (progn
      (setq re2 (/ re 2.0))
      (setq mid-point(vlax-curve-getPointAtDist vla-curve (+ re2(+ facter (* facter (- j 1))))))
      (setq end-point(vlax-curve-getEndPoint vla-curve))
      (slope)
      (cond
 ((= flags 0) (command "line" st-point end-point ""))
 ((= flags 1) (command "arc" st-point mid-point end-point)))
      (setq arc (ssadd (entlast) arc))
      (princ)
      )
    )
  (command "pedit" (entlast)  "y"  "j" arc "" "")
  (setvar "orthomode" oldpara1 )
  (setvar  "osmode" oldpara2)
  (command "undo" "e")
  (prompt "\n*****Designer of CurveToArc V1.0 Is Tang.J.Z.*****")
  (princ)
  )
(defun slope()
  (setq st-point-x(car st-point))
  (setq st-point-y(cadr st-point))
  (setq mid-point-x(car mid-point))
  (setq mid-point-y(cadr mid-point))
  (setq end-point-x(car end-point))
  (setq end-point-y(cadr end-point))
  (cond
    ((and (= st-point-y mid-point-y)(/= end-point-y mid-point-y)) (setq flags 1))
    ((and (/= st-point-y mid-point-y)(= end-point-y mid-point-y)) (setq flags 1))
    ((and (/= st-point-y mid-point-y)(/= end-point-y mid-point-y))
     (progn
      (setq slope-st(/(- mid-point-x st-point-x)(- mid-point-y st-point-y)))
      (setq slope-end(/(- end-point-x mid-point-x )(- end-point-y mid-point-y )))
      (setq flags 1)
      (if (<= (abs (- slope-st slope-end)) 0.0005)
        (setq flags 0)
      )
      (if (>= (abs (- slope-st slope-end)) 0.5)
        (setq flags 2)
      )
     )
    )
    ((and (= st-point-y mid-point-y)(= end-point-y mid-point-y)) (setq flags 0))
    )
)

xyp1964

变什么都行！