SPLINE 转 CIRCLE

zwwen12 · 发表于 2014-4-17 22:03:34

zwwen12 发表于 2014-4-17 20:06
(defun ax:Centroid (poly / pl ms va reg cen)
(setq pl (vlax-ename->vla-object poly)
ms (vla-g ...

(repeat (+ 1 (sslength SS))改为 (repeat (sslength SS)，即可把后面错误去掉。
此命令主要用于多段线转圆，考虑到要检查效果，所以没有删掉原先的多段线或样条曲线。如果要删除，可以再输入删除，"p"(最后选择集）即可。

lucas3 · 发表于 2014-4-17 23:47:27

zwwen12 发表于 2014-4-17 22:03
(repeat (+ 1 (sslength SS))改为 (repeat (sslength SS)，即可把后面错误去掉。
此命令主要用于多段线 ...

谢谢！那对于不是一条封闭的SPLINE，而是多条组成的呢？

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:test2.rar
下载次数:16 文件大小:18.24 KB
下载权限: 不限以上 [免费赚D豆]

xtdwynij · 发表于 2014-4-18 11:56:30

很好，学习了！但前辈们可不可以出一招。多段线转成线呢？这是类似于圆的多段线。但如果是圆弧呢？

st788796 · 发表于 2014-4-18 13:31:24

xtdwynij 发表于 2014-4-18 11:56
很好，学习了！但前辈们可不可以出一招。多段线转成线呢？这是类似于圆的多段线。但如果是圆弧呢？

pline不是线？！

xtdwynij · 发表于 2014-4-18 17:41:07

st788796 发表于 2014-4-18 13:31
pline不是线？！

(defun c:tt (/ d ss pl enl)
(setq d (getreal "\n输入弦高容差<0.5>"))
(if (null d)
(setq d 0.5)
)
(while (setq ss (ssget '((0 . "*line,arc,circle,ellipse"))))
(repeat (setq n (sslength ss))
(setq e (ssname ss (setq n (1- n))))
(setq pl (GXL-GETSAMPLET e d))
(setq enl
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length pl))
)
)
(setq enl (append enl (mapcar '(lambda (x) (cons 10 x)) pl)))
(entmake enl)
(entdel e)
)
)
(princ)
)
(defun gxl-GetSamplet (CURVE D / PerDistToLine GETPOINTS NAME DXF PL I)
(defun PerDistToLine (pt p1 p2 / norm)
(setq norm (mapcar '- p2 p1)
p1 (trans p1 0 norm)
pt (trans pt 0 norm)
)
(abs (- (car pt) (car p1)))
)
(defun getpoints (curve stPar enPar d / ps pe pm)
(setq ps (vlax-curve-getPointAtParam curve stPar)
pe (vlax-curve-getPointAtParam curve enPar)
pm (vlax-curve-getPointAtParam curve (* 0.5 (+ stPar enPar)))
)
(if (<= (PerDistToLine pm ps pe) d)
(list pe)
(append (getpoints curve stpar (* 0.5 (+ stPar enPar)) d)
(getpoints curve (* 0.5 (+ stPar enPar)) enPar d)
)
)
)
(if (= 'vla-object (type curve))
(setq curve (vlax-vla-object->ename curve))
)
(cond
((= "LINE"
(setq name (cdr (assoc 0 (setq dxf (entget curve)))))
)
(list (vlax-curve-getStartPoint curve)
(vlax-curve-getEndPoint curve)
)
)
((= "ARC" name)
(cons (vlax-curve-getstartpoint curve)
(getpoints curve
(vlax-curve-getStartParam curve)
(vlax-curve-getEndParam curve)
d
)
)
)
((= "CIRCLE" name)
(cons (vlax-curve-getstartpoint curve)
(append
(getpoints curve
0
pi
d
)
(getpoints curve
pi
2pi
d
)
)
)
)
((= "ELLIPSE" name)
(if (vlax-curve-isClosed curve)
(cons (vlax-curve-getstartpoint curve)
(append
(getpoints curve
0
pi
d
)
(getpoints curve
pi
2pi
d
)
)
)
(cons (vlax-curve-getstartpoint curve)
(getpoints curve
(vlax-curve-getStartParam curve)
(vlax-curve-getEndParam curve)
d
)
)
)
)
((= "SPLINE" name)
(setq
pl (mapcar 'cdr
(vl-remove-if-not '(lambda (x) (= 11 (car x))) dxf)
)
)
(if (not pl)
(setq pl
(mapcar
'(lambda (x) (vlax-curve-getclosestpointto curve (cdr x)))
(vl-remove-if-not '(lambda (x) (= 10 (car x))) dxf)
)
)
)
(setq pl (mapcar '(lambda (x)
(vlax-curve-getParamAtPoint
curve
x
)
)
pl
)
)
(if (vlax-curve-isClosed curve)
(setq
pl (reverse
(cons (vlax-curve-getEndParam curve) (cdr (reverse pl)))
)
)
)
(setq pl (mapcar 'list pl (cdr pl))
)
(setq pl
(apply 'append
(mapcar
'(lambda (x)
(list
(list (car x) (* 0.5 (apply '+ x)))
(list (* 0.5 (apply '+ x)) (cadr x))
)
)
pl
)
)
)
(cons
(vlax-curve-getStartPoint curve)
(apply
'append
(mapcar '(lambda (x)
(apply 'GETPOINTS (append (cons curve x) (list d)))
)
pl
)
)
)
)
((WCMATCH name "*POLYLINE")
(setq pl nil
i -1
)
(while (< i (vlax-curve-getEndParam curve))
(setq pl (cons (setq i (1+ i)) pl))
)
(setq pl (reverse pl)
pl (mapcar 'list pl (cdr pl))
)
(cons
(vlax-curve-getStartPoint curve)
(apply
'append
(mapcar '(lambda (x)
(apply 'GETPOINTS (append (cons curve x) (list d)))
)
pl
)
)
)
)
)
)

(defun c:tt (/ d ss pl enl) 
  (setq d (getreal "\n输入弦高容差<0.5>")) 
  (if (null d) 
    (setq d 0.5) 
  ) 
  (while (setq ss (ssget '((0 . "*line,arc,circle,ellipse")))) 
    (repeat (setq n (sslength ss)) 
      (setq e (ssname ss (setq n (1- n)))) 
      (setq pl (GXL-GETSAMPLET e d)) 
      (setq enl 
             (list 
               '(0 . "LWPOLYLINE") 
               '(100 . "AcDbEntity") 
               '(100 . "AcDbPolyline") 
               (cons 90 (length pl)) 
             ) 
      ) 
      (setq enl (append enl (mapcar '(lambda (x) (cons 10 x)) pl))) 
      (entmake enl) 
      (entdel e) 
    ) 
  ) 
  (princ) 
) 
(defun gxl-GetSamplet (CURVE D / PerDistToLine GETPOINTS NAME DXF PL I) 
  (defun PerDistToLine (pt p1 p2 / norm) 
    (setq norm (mapcar '- p2 p1) 
    p1   (trans p1 0 norm) 
    pt   (trans pt 0 norm) 
    ) 
    (abs (- (car pt) (car p1))) 
  ) 
  (defun getpoints (curve stPar enPar d / ps pe pm) 
    (setq ps (vlax-curve-getPointAtParam curve stPar) 
    pe (vlax-curve-getPointAtParam curve enPar) 
    pm (vlax-curve-getPointAtParam curve (* 0.5 (+ stPar enPar))) 
    ) 
    (if  (<= (PerDistToLine pm ps pe) d) 
      (list pe) 
      (append (getpoints curve stpar (* 0.5 (+ stPar enPar)) d) 
        (getpoints curve (* 0.5 (+ stPar enPar)) enPar d) 
      ) 
    ) 
  ) 
  (if (= 'vla-object (type curve)) 
    (setq curve (vlax-vla-object->ename curve)) 
  ) 
  (cond 
    ((=  "LINE" 
  (setq name (cdr (assoc 0 (setq dxf (entget curve))))) 
     ) 
     (list (vlax-curve-getStartPoint curve) 
     (vlax-curve-getEndPoint curve) 
     ) 
    ) 
    ((= "ARC" name) 
     (cons (vlax-curve-getstartpoint curve) 
     (getpoints curve 
          (vlax-curve-getStartParam curve) 
          (vlax-curve-getEndParam curve) 
          d 
     ) 
     ) 
    ) 
    ((= "CIRCLE" name) 
     (cons (vlax-curve-getstartpoint curve) 
     (append 
       (getpoints  curve 
      0 
      pi 
      d 
       ) 
       (getpoints  curve 
      pi 
      2pi 
      d 
       ) 
     ) 
     ) 
    ) 
    ((= "ELLIPSE" name) 
     (if (vlax-curve-isClosed curve) 
       (cons (vlax-curve-getstartpoint curve) 
       (append 
         (getpoints curve 
        0 
        pi 
        d 
         ) 
         (getpoints curve 
        pi 
        2pi 
        d 
         ) 
       ) 
       ) 
       (cons (vlax-curve-getstartpoint curve) 
       (getpoints  curve 
      (vlax-curve-getStartParam curve) 
      (vlax-curve-getEndParam curve) 
      d 
       ) 
       ) 
     ) 
    ) 
    ((= "SPLINE" name) 
     (setq 
       pl (mapcar 'cdr 
      (vl-remove-if-not '(lambda (x) (= 11 (car x))) dxf) 
    ) 
     ) 
     (if (not pl) 
       (setq pl 
        (mapcar 
    '(lambda (x) (vlax-curve-getclosestpointto curve (cdr x))) 
    (vl-remove-if-not '(lambda (x) (= 10 (car x))) dxf) 
        ) 
       ) 
     ) 
     (setq pl (mapcar '(lambda (x) 
       (vlax-curve-getParamAtPoint 
         curve 
         x 
       ) 
           ) 
          pl 
        ) 
     ) 
     (if (vlax-curve-isClosed curve) 
       (setq 
   pl (reverse 
        (cons (vlax-curve-getEndParam curve) (cdr (reverse pl))) 
      ) 
       ) 
     ) 
     (setq pl (mapcar 'list pl (cdr pl)) 
     ) 
     (setq pl 
      (apply 'append 
       (mapcar 
         '(lambda (x) 
      (list 
        (list (car x) (* 0.5 (apply '+ x))) 
        (list (* 0.5 (apply '+ x)) (cadr x)) 
      ) 
          ) 
         pl 
       ) 
      ) 
     ) 
     (cons 
       (vlax-curve-getStartPoint curve) 
       (apply 
   'append 
   (mapcar '(lambda (x) 
        (apply 'GETPOINTS (append (cons curve x) (list d))) 
      ) 
     pl 
   ) 
       ) 
     ) 
    ) 
    ((WCMATCH name "*POLYLINE") 
     (setq pl nil 
     i  -1 
     ) 
     (while (
       (setq pl (cons (setq i (1+ i)) pl)) 
     ) 
     (setq pl (reverse pl) 
     pl (mapcar 'list pl (cdr pl)) 
     ) 
     (cons 
       (vlax-curve-getStartPoint curve) 
       (apply 
   'append 
   (mapcar '(lambda (x) 
        (apply 'GETPOINTS (append (cons curve x) (list d))) 
      ) 
     pl 
   ) 
       ) 
     ) 
    ) 
  ) 
)

不知道怎么说。楼主那样的转换LINE和ARC和CIRCLE 这样子。还没有开始学习。不过找到了G版的！现附上。不过转换出来的线有角，好像不怎么圆滑。

zwwen12 · 发表于 2014-4-18 21:15:04

lucas3 发表于 2014-4-17 23:47
谢谢！那对于不是一条封闭的SPLINE，而是多条组成的呢？

对于这种，给个思路，取得几段样条曲线的端点，三点画圆。

lucas3 · 发表于 2014-4-18 21:50:09

zwwen12 发表于 2014-4-18 21:15
对于这种，给个思路，取得几段样条曲线的端点，三点画圆。

那对于第一种情况，即封闭的spline又不行了吧，或者说像圆弧的一段spline又怎么处理呢？如果通杀就最好

zwwen12 · 发表于 2014-4-18 22:25:47

lucas3 发表于 2014-4-18 21:50
那对于第一种情况，即封闭的spline又不行了吧，或者说像圆弧的一段spline又怎么处理呢？如果通杀就最好

1.取样条曲线的第一点
2.样条曲线的长度
3.得出距离样条曲线第一点长度三分之一之处的点
4.得出距离样条曲线第一点长度三分之二之处的点
5.三点画圆。

lucas3 · 发表于 2014-4-18 22:31:42

zwwen12 发表于 2014-4-18 22:25
1.取样条曲线的第一点
2.样条曲线的长度
3.得出距离样条曲线第一点长度三分之一之处的点

谢谢大师给思路，太复杂，只能想想啊

lucas3 · 发表于 2014-4-18 23:00:18

本帖最后由 lucas3 于 2014-4-18 23:03 编辑

zwwen12 发表于 2014-4-18 22:25
1.取样条曲线的第一点
2.样条曲线的长度
3.得出距离样条曲线第一点长度三分之一之处的点

只知道3点画圆{:soso_e127:}

(defun c:3PCircle ( / p1 p2 p3 lst )
(if
(and
(setq p1 (getpoint "\nSpecify 1st Point: "))
(setq p2 (getpoint "\nSpecify 2nd Point: " p1))
(setq p3 (getpoint "\nSpecify 3rd Point: " p2))
(setq lst (LM:3PCircle (trans p1 1 0) (trans p2 1 0) (trans p3 1 0)))
)
(entmake (append '((0 . "CIRCLE")) (mapcar 'cons '(10 40) lst)))
)
(princ)
)
(defun c:3PGrCircle ( / p1 p2 p3 lst cir )
(if
(and
(setq p1 (getpoint "\nSpecify 1st Point: "))
(setq p2 (getpoint "\nSpecify 2nd Point: " p1))
(setq p3 (cadr (grread t 13 0)))
(setq lst (LM:3PCircle (setq p1 (trans p1 1 0)) (setq p2 (trans p2 1 0)) (trans p3 1 0)))
(setq cir (entmakex (append '((0 . "CIRCLE")) (mapcar 'cons '(10 40) lst))))
(setq cir (list (cons -1 cir)))
(princ "\nSpecify 3rd Point: ")
)
(while (= 5 (car (setq gr (grread t 13 0))))
(if (setq lst (LM:3PCircle p1 p2 (trans (cadr gr) 1 0)))
(entmod (append cir (mapcar 'cons '(10 40) lst)))
)
)
)
(princ)
)

(defun c:3PCircle ( / p1 p2 p3 lst ) 
    (if 
        (and 
            (setq p1  (getpoint "\nSpecify 1st Point: ")) 
            (setq p2  (getpoint "\nSpecify 2nd Point: " p1)) 
            (setq p3  (getpoint "\nSpecify 3rd Point: " p2)) 
            (setq lst (LM:3PCircle (trans p1 1 0) (trans p2 1 0) (trans p3 1 0))) 
        ) 
        (entmake (append '((0 . "CIRCLE")) (mapcar 'cons '(10 40) lst))) 
    ) 
    (princ) 
) 
 
(defun c:3PGrCircle ( / p1 p2 p3 lst cir ) 
    (if 
        (and 
            (setq p1  (getpoint "\nSpecify 1st Point: ")) 
            (setq p2  (getpoint "\nSpecify 2nd Point: " p1)) 
            (setq p3  (cadr (grread t 13 0))) 
            (setq lst (LM:3PCircle (setq p1 (trans p1 1 0)) (setq p2 (trans p2 1 0)) (trans p3 1 0))) 
            (setq cir (entmakex (append '((0 . "CIRCLE")) (mapcar 'cons '(10 40) lst)))) 
            (setq cir (list (cons -1 cir))) 
            (princ "\nSpecify 3rd Point: ") 
        ) 
        (while (= 5 (car (setq gr (grread t 13 0)))) 
            (if (setq lst (LM:3PCircle p1 p2 (trans (cadr gr) 1 0))) 
                (entmod (append cir (mapcar 'cons '(10 40) lst))) 
            ) 
        ) 
    ) 
    (princ) 
)

;; 3-Point Circle - Lee Mac
;; Returns the Center and Radius of the Circle defined
;; by three supplied points.
(defun LM:3PCircle ( p1 p2 p3 / cn m1 m2 )
(setq m1 (mid p1 p2)
m2 (mid p2 p3)
)
(if
(setq cn
(inters
m1 (polar m1 (+ (angle p1 p2) (/ pi 2.)) 1.0)
m2 (polar m2 (+ (angle p2 p3) (/ pi 2.)) 1.0)
nil
)
)
(list cn (distance cn p1))
)
)
;; Midpoint - Lee Mac
;; Returns the midpoint of two points
(defun mid ( a b )
(mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b)
)

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

[求助] SPLINE 转 CIRCLE

点评

点评

点评

点评

点评

点评