【请教】用什么办法实现多段线拟合

wmz

2. ;;;加入编码
   
3. (defun SetData (Obj Data / dxf)
   
4.    (setq  dxf (entget obj))
   
5.    (setq data (list(list "SOUTH" (cons 1000 data))))
   
6.    (foreach x Data
   
7.         (regapp (car x))
   
8.         (entmod (append dxf (list(cons -3 (list x)))))
   
9.    )
   
10. )
    
11. (defun Hdgxhs (lst n bh h blc / XX xk LAY YS e)
    
12.   (setq sw 34.26 BL (/ blc 1000.0))
    
13.   (cond ((>= h sw)(setq LAY "DGX" XX "CONTINUOUS"))
    
14.   ((< h sw)(setq LAY "DSX" XX "X11"))
    
15.   )
    
16.   (cond ((= (rem h 5) 0)(setq XK (* 0.3 BL) YS 3))
    
17.   ((/= (rem h 5) 0)(setq XK (* 0.15 BL) YS 2))
    
18.   )
    
19.   (cond ((and(= (rem h 5) 0) (= LAY "DGX"))(setq xDATA "201102"))
    
20.         ((and(/= (rem h 5) 0)(= LAY "DGX"))(setq xDATA "201101"))
    
21.   ((and(= (rem h 5) 0) (= LAY "DSX"))(setq xDATA "186302"))
    
22.         ((and(/= (rem h 5) 0)(= LAY "DSX"))(setq xDATA "186301"))
    
23.   )
    
24.   
    
25.   (entmake (append
    
26.        (list '(0 . "LWPOLYLINE")
    
27.        '(100 . "AcDbEntity")
    
28.        '(100 . "AcDbPolyline")
    
29.         (cons 8 LAY)
    
30.         (cons 62 Ys)
    
31.         (cons 90 n)
    
32.         (cons 6 xx)
    
33.         (cons 43 xk)
    
34.         (cons 38 h)
    
35.         (cons 70 bh)
    
36.        )
    
37.       (mapcar '(lambda (pt)(cons 10 pt)) lst ))
    
38.   )
    
39.   (setq e (entlast))
    
40.   (SetData e xDATA)
    
41.   (command "_pedit" e "s" "L" "on" "");;;这一句太慢，代替这一句！
    
42. )  

;;;加入编码<br /> (defun SetData (Obj Data / dxf)<br />    (setq  dxf (entget obj))<br />    (setq data (list(list "SOUTH" (cons 1000 data))))<br />    (foreach x Data<br />         (regapp (car x))<br />         (entmod (append dxf (list(cons -3 (list x)))))<br />    )<br /> )<br /> (defun Hdgxhs (lst n bh h blc / XX xk LAY YS e)<br />   (setq sw 34.26 BL (/ blc 1000.0))<br />   (cond ((>= h sw)(setq LAY "DGX" XX "CONTINUOUS"))<br />   ((< h sw)(setq LAY "DSX" XX "X11"))<br />   )<br />   (cond ((= (rem h 5) 0)(setq XK (* 0.3 BL) YS 3))<br />   ((/= (rem h 5) 0)(setq XK (* 0.15 BL) YS 2))<br />   )<br />   (cond ((and(= (rem h 5) 0) (= LAY "DGX"))(setq xDATA "201102"))<br />         ((and(/= (rem h 5) 0)(= LAY "DGX"))(setq xDATA "201101"))<br />   ((and(= (rem h 5) 0) (= LAY "DSX"))(setq xDATA "186302"))<br />         ((and(/= (rem h 5) 0)(= LAY "DSX"))(setq xDATA "186301"))<br />   )<br />   <br />   (entmake (append<br />        (list '(0 . "LWPOLYLINE")<br />        '(100 . "AcDbEntity")<br />        '(100 . "AcDbPolyline")<br />         (cons 8 LAY)<br />         (cons 62 Ys)<br />         (cons 90 n)<br />         (cons 6 xx)<br />         (cons 43 xk)<br />         (cons 38 h)<br />         (cons 70 bh)<br />        )<br />       (mapcar '(lambda (pt)(cons 10 pt)) lst ))<br />   )<br />   (setq e (entlast))<br />   (SetData e xDATA)<br />   (command "_pedit" e "s" "L" "on" "");;;这一句太慢，代替这一句！<br /> )  

wmz

我的意思是用(vla-put-type e acQuadSplinePoly)是不是快一些？请Ｇ版主帮忙！

llsheng_73

1. (defun Hdgxhs(lst bh h blc / xk LAY e)
   
2.   (if(not(tblsearch"appid""SOUTH"))(regapp "SOUTH"))
   
3.   (setq sw 34.26 BL (/ blc 1000.0)
   
4.         LAY(if(>= h sw)"DGX""DSX")
   
5.         XK(*(IF(=(rem h 5)0)0.3 0.15)BL)
   
6.         e(ENTMAKEx(LIST'(0 . "POLYLINE")'(100 . "AcDbEntity")'(100 . "AcDb2dPolyline")
   
7.                (cons 8 LAY)
   
8.                (cons 6 (if(>= h sw)"CONTINUOUS""X11"))
   
9.                (cons 62 (IF(=(rem h 5)0)3 1))
   
10.                (cons 70 (+ 4 bh)))))
    
11.   (foreach x lst(entmakex(list'(0 . "VERTEX")(list 10 (car x)(cadr x) h)(cons 40 xk)(cons 41 xk))))
    
12.   (ENTMAKE'((0 . "seqend")))
    
13.   (entmod(append(entget e)(list(list -3(list"SOUTH"(cons 1000(cond((and(=(rem h 5)0)(="DGX"LAY))"201102")
    
14.         ((and(/=(rem h 5)0)(="DGX"LAY))"201101")
    
15.         ((and(=(rem h 5)0)(="DSX"LAY))"186302")
    
16.         ((and(/=(rem h 5)0)(="DSX"LAY))"186301"))))))))
    
17. )

(defun Hdgxhs(lst bh h blc / xk LAY e)<br />   (if(not(tblsearch"appid""SOUTH"))(regapp "SOUTH"))<br />   (setq sw 34.26 BL (/ blc 1000.0)<br />         LAY(if(>= h sw)"DGX""DSX")<br />         XK(*(IF(=(rem h 5)0)0.3 0.15)BL)<br />         e(ENTMAKEx(LIST'(0 . "POLYLINE")'(100 . "AcDbEntity")'(100 . "AcDb2dPolyline")<br />                (cons 8 LAY)<br />                (cons 6 (if(>= h sw)"CONTINUOUS""X11"))<br />                (cons 62 (IF(=(rem h 5)0)3 1))<br />                (cons 70 (+ 4 bh)))))<br />   (foreach x lst(entmakex(list'(0 . "VERTEX")(list 10 (car x)(cadr x) h)(cons 40 xk)(cons 41 xk))))<br />   (ENTMAKE'((0 . "seqend")))<br />   (entmod(append(entget e)(list(list -3(list"SOUTH"(cons 1000(cond((and(=(rem h 5)0)(="DGX"LAY))"201102")<br />         ((and(/=(rem h 5)0)(="DGX"LAY))"201101")<br />         ((and(=(rem h 5)0)(="DSX"LAY))"186302")<br />         ((and(/=(rem h 5)0)(="DSX"LAY))"186301"))))))))<br /> )

wmz

十分感谢！程序写的太棒了！
但，仍然没有解决拟合问题（查特性时是拟合了，但依然是折线），而且扩展属性也没有加进去。
速度用了9秒（7000个三角形的等高线）。我那个如果屏蔽掉拟合那一句，即
(command "_pedit" e "s" "L" "on" "")，只要8秒，一加上这一句就达到14秒，我嫌他用时太长，故求助！
再次谢谢你！