3D的 POLYLINE的合并

marting

1. ;;; ULP -Gilles Chanteau- 01/01/06
   
2. ;;; Crée une polyligne sur le contour de chaque groupe de polylignes fermées et contiguës sélectionnées.
   
3. ;;; Mise à jour: 19/04/2011 (fonctionnement 3d)
   
4. ;;; Creates a polyline on the contour of each group and adjacent closed polylines selected.
   
5. ;;; Updated: 4/19/2011 (Operation 3d)
   
6. 
   
7. (defun c:upl (/ *error* ss lst erase cnt native)
   
8.   (vl-load-com)
   
9. 
   
10.   (or *acad* (setq *acad* (vlax-get-acad-object)))
    
11.   (or *acdoc* (setq *acdoc* (vla-get-activeDocument *acad*)))
    
12. 
    
13.   (setq native (vl-string-search "(FR)" (strcase (ver)))) ; CAB
    
14. ;;;***************************************************************;;;
    
15. 
    
16.   (defun *error* (msg)
    
17.     (and msg
    
18.          (or
    
19.            (= msg (if native "Fonction annulée" " Function canceled"))
    
20.            (= msg (if native"quitter / sortir abandon" "leave / drop out"))
    
21.          )
    
22.          (princ (strcat (if native "\nErreur: " "\nError: ") msg))
    
23.     )
    
24.     (vla-endundomark *acdoc*)
    
25.     (princ)
    
26.   )
    
27. 
    
28.   (prompt (if native "\nSélectionnez les polylignes à fusionner: " "\nSelect polylines to merge: "))
    
29.   (if (ssget '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1)))
    
30.     (progn
    
31.       (if native (initget "Oui Non")(initget "Yes No"))
    
32.       (setq erase (getkword (if native "\nEffacer les polylignes source ? [Oui/Non] <Oui>: "
    
33.                                        "\nClear polylines source? [Yes / No] <Yes>: ")))
    
34.       (vlax-for        obj (setq ss (vla-get-ActiveSelectionSet *acdoc*))
    
35.         (setq lst (cons obj lst))
    
36.       )
    
37.       (vla-Delete ss)
    
38.       (vla-StartUndoMark *acdoc*)
    
39.       (setq cnt (gc:MergePlines lst (/= erase (if native "Non" "No"))))
    
40.       (vla-EndUndoMark *acdoc*)
    
41.       (princ (strcat "\n"
    
42.                      (itoa cnt)
    
43.                      (if (< 1 cnt)
    
44.                        (if native " polylignes créées." "polylines created.")
    
45.                        (if native " polyligne créée." "polyline created.")
    
46.                      )
    
47.              )
    
48.       )
    
49.     )
    
50.   )
    
51.   (*error* nil)
    
52. )
    

;;; ULP -Gilles Chanteau- 01/01/06<br /> ;;; Crée une polyligne sur le contour de chaque groupe de polylignes fermées et contigu&#235;s sélectionnées.<br /> ;;; Mise à jour: 19/04/2011 (fonctionnement 3d)<br /> ;;; Creates a polyline on the contour of each group and adjacent closed polylines selected.<br /> ;;; Updated: 4/19/2011 (Operation 3d)<br /> <br /> (defun c:upl (/ *error* ss lst erase cnt native)<br />   (vl-load-com)<br /> <br />   (or *acad* (setq *acad* (vlax-get-acad-object)))<br />   (or *acdoc* (setq *acdoc* (vla-get-activeDocument *acad*)))<br /> <br />   (setq native (vl-string-search "(FR)" (strcase (ver)))) ; CAB<br /> ;;;***************************************************************;;;<br /> <br />   (defun *error* (msg)<br />     (and msg<br />          (or<br />            (= msg (if native "Fonction annulée" " Function canceled"))<br />            (= msg (if native"quitter / sortir abandon" "leave / drop out"))<br />          )<br />          (princ (strcat (if native "\nErreur: " "\nError: ") msg)) <br />     )<br />     (vla-endundomark *acdoc*)<br />     (princ)<br />   )<br /> <br />   (prompt (if native "\nSélectionnez les polylignes à fusionner: " "\nSelect polylines to merge: "))<br />   (if (ssget '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1)))<br />     (progn<br />       (if native (initget "Oui Non")(initget "Yes No"))<br />       (setq erase (getkword (if native "\nEffacer les polylignes source ? [Oui/Non] <Oui>: "<br />                                        "\nClear polylines source? [Yes / No] <Yes>: ")))<br />       (vlax-for        obj (setq ss (vla-get-ActiveSelectionSet *acdoc*))<br />         (setq lst (cons obj lst))<br />       )<br />       (vla-Delete ss)<br />       (vla-StartUndoMark *acdoc*)<br />       (setq cnt (gc:MergePlines lst (/= erase (if native "Non" "No"))))<br />       (vla-EndUndoMark *acdoc*)<br />       (princ (strcat "\n"<br />                      (itoa cnt)<br />                      (if (< 1 cnt)<br />                        (if native " polylignes créées." "polylines created.")<br />                        (if native " polyligne créée." "polyline created.")<br />                      )<br />              )<br />       )<br />     )<br />   )<br />   (*error* nil)<br /> )<br />

MergePlines

Array，本帖隐藏的内容需要发帖数高于 100 才可浏览，你当前发帖数为

dnbcgrass

回复学习学习！

sicky111

都玩3D的了。

pezyl

我3d都还没用过，失败

sh_h

跟着大师好好学习，天天向上！！！

q3_2006

这个厉害...谢谢分享了!

Linhay

这个厉害...谢谢分享了!

MENGZE

本帖回复已隐藏回复内容可见