join and close polyline as much as possible

bmn2k3v6

2. hey, guys,here is the code i tried to join polyline as much as possible, then close them, but it just could close one polyline, any idea about this?   thank u very much!!!   ; this routine is try to join ployline as much as possible, then
3.    ; close them.
4.    
5.    ;;; returns the first group value of an entity.
6.    ;;; like the wellknown (dxf) function but accepts all kinds of
7.    ;;; entity representations (ename, entget list, entsel list)
8.    
9.    (defun GETVAL (grp ele)                                 ;"dxf value" of any ent...       (cond ((= (type ele) 'ENAME)                   ;ENAME                       (cdr (assoc grp (entget ele))))                   ((not ele) nil)                                 ;empty value                   ((not (listp ele)) nil)                 ;invalid ele                   ((= (type (car ele)) 'ENAME)       ;entsel-list                       (cdr (assoc grp (entget (car ele)))))                   (T (cdr (assoc grp ele)))))         ;entget-list   ;--------------------------------------------------------------------
10.    ;;;   (gettyp pline) => "POLYLINE"   (defun GETTYP (ele)                                         ;return type
11.        (getval 0 ele))   ;--------------------------------------------------------------------
12.    ;;; assure ENAME
13.    ;;; convert the entity to type ENAME    (defun ENTITY (ele)                                         ;convert to element name       (cond           ;accepts the following types:           ((= (type ele) 'ENAME) ele)                         ; ENAME           ((not (listp ele)) nil)                                 ; error: no list           ((= (type (car ele)) 'ENAME) (car ele)) ; entsel-list           ((cdr (assoc -1 ele)))                                   ; entget-list or nil       )   )   ;--------------------------------------------------------------------
14.   
15.    (defun getval (grp ele) (cdr (assoc grp (entget (entity ele)))))   ;--------------------------------------------------------------------
16.    ;;; (istypep ele "TEXT")
17.    ;;; is element a "SOLID"?   (defun istypep (ele typ)                                     ;check type
18.        (= (gettyp ele) typ))   ;--------------------------------------------------------------------
19.    ;;; (istypep ele '("TEXT" "ATTDEF"))
20.    ;;; is element a "TEXT" or a "ATTDEF"?   (defun ISTYPEP (ele typ)     ;better implementation to accept lists too       (cond           ((listp typ)     (member (gettyp ele) typ))            ((stringp typ) (= (gettyp ele) typ))           ;assume typ uppercase           (T nil)))   ;--------------------------------------------------------------------
21.    ;;; (getpt (entsel))   => ( 0.1 10.0 24)   (defun GETPT (ele)       ;return the startpoint of any element       (getval 10 ele))       ;group 10   ;--------------------------------------------------------------------
22.    ;;; (getflag pline)   => 1 if closed   (defun GETFLAG (ele) (getval 70 ele)) ;same with the entity flag   ;--------------------------------------------------------------------
23.    ;;; bitvalue val in flag of element set?
24.    ;;; (flagsetp 1 pline)     => T if closed
25.    
26.    (defun FLAGSETP (val ele)       (bitsetp val (getflag ele)))     
27.    ;--------------------------------------------------------------------
28.    ;;; (bitsetp 4 12) => T     ;bitvalue 4 (=2.Bit) in 12 (=4+8) is set   (defun BITSETP (val flag)       (= (logand val flag) val))
29.    ;--------------------------------------------------------------------
30.    ;;; convert selection set to list,
31.    ;;; it's to use ai_ssget, because some ents could be on locked layers
32.    ;;; (sslist (ai_ssget (ssget))) => list of selected unlocked ents
33.    ;;; or   (mapcar 'entupd (sslist (ssget "X" '((8 . "TEMP")))))
34.    ;;;             - regens all entities on layer TEMP   (defun SSLIST (ss / n lst)       (if (= (type ss) 'PICKSET)           (repeat (setq n (sslength ss))               (setq n (1- n)                           lst (cons (ssname ss n) lst)))))   ;--------------------------------------------------------------------
35.    ;;; apply a function to each ent in ss,
36.    ;;; (ssmap 'entupd (ssget))     ; regenerate only some entities   (defun SSMAP (fun ss / n)       (if (= 'PICKSET (type ss))           (repeat (setq n (sslength ss))               (apply fun (list (ssname ss (setq n (1- n))))))))   ;--------------------------------------------------------------------
37.    ;;; This tries to join as much polylines as possible.   (defun C:JOINPOLY (/ ele ss)       (foreach ele (sslist (setq ss (ssget)))         ;process lists           (if (entget ele)                                                   ;not already joined               (cond                                                                     ;(then it would be nil)                   ;((istypep ele '("ARC" "LINE"))             ; some pillars might use
38.               ; lines or arcs????                       ;(command "_PEDIT" ele "_Y" "_J" ss "" ""); convert and JOIN                   ;)                   ((and (istypep ele '("POLYLINE" "LWPOLYLINE"))                                (not (flagsetp 1 ele))                   ;not closed
39.                                (< (rem (getflag ele) 128) 8))   ;ignore meshes and such                       (command "_PEDIT" ele "_J" ss "" "")                   )               )           )       )   )
40.    ;--------------------------------------------------------------------
41.    ;;; This closes as much polylines as possible.   (defun C:CLOSEPOLY (/ ele ss)         (foreach ele (sslist (setq ss (ssget)))         ;process lists               (if (and (istypep ele '("POLYLINE" "LWPOLYLINE"))                                (not (flagsetp 1 ele))                   ;not closed
42.                                (< (rem (getflag ele) 128) 8))   ;ignore meshes and such                       (command "_PEDIT" ele "_C" ss "" "")         (command "_PEDIT" ele "_X" ss "" "")         
43.       
44.                )         )   )  

hey, guys,here is the code i tried to join polyline as much as possible, then close them, but it just could close one polyline, any idea about this?   thank u very much!!!   ; this routine is try to join ployline as much as possible, then    ; close them.        ;;; returns the first group value of an entity.    ;;; like the wellknown (dxf) function but accepts all kinds of    ;;; entity representations (ename, entget list, entsel list)        (defun GETVAL (grp ele)                                 ;"dxf value" of any ent...       (cond ((= (type ele) 'ENAME)                   ;ENAME                       (cdr (assoc grp (entget ele))))                   ((not ele) nil)                                 ;empty value                   ((not (listp ele)) nil)                 ;invalid ele                   ((= (type (car ele)) 'ENAME)       ;entsel-list                       (cdr (assoc grp (entget (car ele)))))                   (T (cdr (assoc grp ele)))))         ;entget-list   ;--------------------------------------------------------------------    ;;;   (gettyp pline) => "POLYLINE"   (defun GETTYP (ele)                                         ;return type        (getval 0 ele))   ;--------------------------------------------------------------------    ;;; assure ENAME    ;;; convert the entity to type ENAME    (defun ENTITY (ele)                                         ;convert to element name       (cond           ;accepts the following types:           ((= (type ele) 'ENAME) ele)                         ; ENAME           ((not (listp ele)) nil)                                 ; error: no list           ((= (type (car ele)) 'ENAME) (car ele)) ; entsel-list           ((cdr (assoc -1 ele)))                                   ; entget-list or nil       )   )   ;--------------------------------------------------------------------       (defun getval (grp ele) (cdr (assoc grp (entget (entity ele)))))   ;--------------------------------------------------------------------    ;;; (istypep ele "TEXT")    ;;; is element a "SOLID"?   (defun istypep (ele typ)                                     ;check type        (= (gettyp ele) typ))   ;--------------------------------------------------------------------    ;;; (istypep ele '("TEXT" "ATTDEF"))    ;;; is element a "TEXT" or a "ATTDEF"?   (defun ISTYPEP (ele typ)     ;better implementation to accept lists too       (cond           ((listp typ)     (member (gettyp ele) typ))            ((stringp typ) (= (gettyp ele) typ))           ;assume typ uppercase           (T nil)))   ;--------------------------------------------------------------------    ;;; (getpt (entsel))   => ( 0.1 10.0 24)   (defun GETPT (ele)       ;return the startpoint of any element       (getval 10 ele))       ;group 10   ;--------------------------------------------------------------------    ;;; (getflag pline)   => 1 if closed   (defun GETFLAG (ele) (getval 70 ele)) ;same with the entity flag   ;--------------------------------------------------------------------    ;;; bitvalue val in flag of element set?    ;;; (flagsetp 1 pline)     => T if closed        (defun FLAGSETP (val ele)       (bitsetp val (getflag ele)))         ;--------------------------------------------------------------------    ;;; (bitsetp 4 12) => T     ;bitvalue 4 (=2.Bit) in 12 (=4+8) is set   (defun BITSETP (val flag)       (= (logand val flag) val))    ;--------------------------------------------------------------------    ;;; convert selection set to list,    ;;; it's to use ai_ssget, because some ents could be on locked layers    ;;; (sslist (ai_ssget (ssget))) => list of selected unlocked ents    ;;; or   (mapcar 'entupd (sslist (ssget "X" '((8 . "TEMP")))))    ;;;             - regens all entities on layer TEMP   (defun SSLIST (ss / n lst)       (if (= (type ss) 'PICKSET)           (repeat (setq n (sslength ss))               (setq n (1- n)                           lst (cons (ssname ss n) lst)))))   ;--------------------------------------------------------------------    ;;; apply a function to each ent in ss,    ;;; (ssmap 'entupd (ssget))     ; regenerate only some entities   (defun SSMAP (fun ss / n)       (if (= 'PICKSET (type ss))           (repeat (setq n (sslength ss))               (apply fun (list (ssname ss (setq n (1- n))))))))   ;--------------------------------------------------------------------    ;;; This tries to join as much polylines as possible.   (defun C:JOINPOLY (/ ele ss)       (foreach ele (sslist (setq ss (ssget)))         ;process lists           (if (entget ele)                                                   ;not already joined               (cond                                                                     ;(then it would be nil)                   ;((istypep ele '("ARC" "LINE"))             ; some pillars might use               ; lines or arcs????                       ;(command "_PEDIT" ele "_Y" "_J" ss "" ""); convert and JOIN                   ;)                   ((and (istypep ele '("POLYLINE" "LWPOLYLINE"))                                (not (flagsetp 1 ele))                   ;not closed                                (< (rem (getflag ele) 128) 8))   ;ignore meshes and such                       (command "_PEDIT" ele "_J" ss "" "")                   )               )           )       )   )    ;--------------------------------------------------------------------    ;;; This closes as much polylines as possible.   (defun C:CLOSEPOLY (/ ele ss)         (foreach ele (sslist (setq ss (ssget)))         ;process lists               (if (and (istypep ele '("POLYLINE" "LWPOLYLINE"))                                (not (flagsetp 1 ele))                   ;not closed                                (< (rem (getflag ele) 128) 8))   ;ignore meshes and such                       (command "_PEDIT" ele "_C" ss "" "")         (command "_PEDIT" ele "_X" ss "" "")                                )         )   )  

龙龙仔

查看 http://bbs.mjtd.com/forum.php?mod=viewthread&tid=12642&replyID=56400

bmn2k3v6

龙龙仔, my purpose is to join polylines as much as possible, after that, i need to close every polyline, but the aotolisp code below just close only one polyline, u know the "pedit" command for polyline ask "Close" or "Open" all the time, do u have any idea overcome this problem??? ;;; This closes as much polylines as possible. (defun C:CLOSEPOLY (/ ele ss) (foreach ele (sslist (setq ss (ssget))) ;process lists (if (and (istypep ele '("POLYLINE" "LWPOLYLINE")) (not (flagsetp 1 ele)) ;not closed
(< (rem (getflag ele) 128) 8)) ;ignore meshes and such (command "_PEDIT" ele "_C" ss "" "") (command "_PEDIT" ele "_X" ss "" "")

) ) )

龙龙仔

傳個測試圖上來吧!

bmn2k3v6

龙龙仔

(defun C:CLOSEPOLY (/ ENT N SS)
(vl-load-com)
(setq SS (ssget '((0 . "*POLYLINE")))
N 0
)
(repeat (sslength SS)
(if (= :vlax-false
(vla-get-closed
(setq ENT (vlax-ename->vla-object (ssname SS N)))
)
)
(vla-put-closed ENT :vlax-true)
)
(setq N (1+ N))
)
(princ)
)

SWAYWOOD

龙版，为什么我在测试楼上的程序的时候出现：closepoly ; 错误: COM 异常: 访问 OLE 注册表的错误，


公司里是win2000的操作系统，我们没有安装权限， 是不是和权限有关，所以无法运行(vl-load-com)这一句？

龙龙仔

(vl-load-com) 是載入 Visual LISP 延伸函數至 AutoLISP
這個函數載入 Visual LISP 提供的延伸 AutoLISP 函數。Visual LISP 延伸函數實施 ActiveX 及經由 AutoLisp 支援 AutoCAD 反應裝置，另外也提供 ActiveX 公用程式及資料轉換函數、字典處理函數及曲線測量函數。
如果已載入該副檔名，vl-load-com 不做任何事。 你用那一版AUTOCAD?

无痕

lucas,我觉得不必先判断是否闭合，以下即便ss的filter不进行筛选，直接put－closed也可以。没必要花时间在判断是否闭合上

2. ;;将不闭合的pl线闭合.
3. (defun C:CLOSEPOLY (/ N SS)
4.    (vl-load-com)
5.    (setq SS (ssget '((0 . "*polyline")(-4 . "<NOT")(-4 . "&") (70 . 1)(-4 . "NOT>")))
6.                  N   -1)
7.    (repeat (sslength SS)
8.          (vla-put-closed (vlax-ename->vla-object (ssname SS (setq N (1+ N)))) :vlax-true)
9.    )(princ)
10. )

;;将不闭合的pl线闭合. (defun C:CLOSEPOLY (/ N SS)    (vl-load-com)    (setq SS (ssget '((0 . "*polyline")(-4 . "<NOT")(-4 . "&") (70 . 1)(-4 . "NOT>")))                  N   -1)    (repeat (sslength SS)          (vla-put-closed (vlax-ename->vla-object (ssname SS (setq N (1+ N)))) :vlax-true)    )(princ) )

3. ;;;将不闭合的pl线闭合.---命令方式.
4. (defun C:CLOSEPOLY ()
5.    (vl-cmdf "_.pedit" "m" (ssget '((0 . "*polyline")(-4 . "<NOT")(-4 . "&") (70 . 1)(-4 . "NOT>"))) "" "c" "")
6. )

;;;将不闭合的pl线闭合.---命令方式. (defun C:CLOSEPOLY ()    (vl-cmdf "_.pedit" "m" (ssget '((0 . "*polyline")(-4 . "<NOT")(-4 . "&") (70 . 1)(-4 . "NOT>"))) "" "c" "") )

龙龙仔

本來想判斷只有一段的pline不閉合,但又懶.... 8-)