面域转多段线

nyistjz

我计划写个程序，把面域分解一下，再合并成多段线，但是不成功，应该是无法选中分解后的所有线段。
还请朋友们帮忙看一下怎么修改程序，感谢 ！


(defun c:gg()
        (setq ss (ssget))
        (while (setq s (ssget "p"))
                (command-s "explode" s "")
        )
        (setq ss (ssget "p"))
        (command-s "pedit" "m" ss "" "J" "J" "E" 0 "")
)



修正好的源码在7楼！

xyp1964

1. (defun c:tt ()
   
2.   "面域转多线"
   
3.   (if (setq ss (ssget '((0 . "region"))))
   
4.     (progn
   
5.       (setvar "qaflags" 1)
   
6.       (setq s0 (entlast))
   
7.       (command-s "explode" ss "")
   
8.       (setq ss (ssadd))
   
9.       (while (setq s0 (entnext s0)) (ssadd s0 ss))
   
10.       (setvar "PEDITACCEPT" 1)
    
11.       (command "pedit" "M" ss "" "j" "j" "B" 0 "")
    
12.     )
    
13.   )
    
14.   (princ)
    
15. )

(defun c:tt ()<br />   "面域转多线"<br />   (if (setq ss (ssget '((0 . "region"))))<br />     (progn<br />       (setvar "qaflags" 1)<br />       (setq s0 (entlast))<br />       (command-s "explode" ss "")<br />       (setq ss (ssadd))<br />       (while (setq s0 (entnext s0)) (ssadd s0 ss))<br />       (setvar "PEDITACCEPT" 1)<br />       (command "pedit" "M" ss "" "j" "j" "B" 0 "")<br />     )<br />   )<br />   (princ)<br /> )

自贡黄明儒

QAFLAGS 与爆破有关
PEDITACCEPT 与多段线联接有关
搞定这两个变量，基本上就成了。

汉域-奎

http://bbs.mjtd.com/forum.php?mo ... =%C3%E6%D3%F2%D7%AA

nyistjz

汉域-奎 发表于 2024-11-9 17:16
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=186369&highlight=%C3%E6%D3%F2%D7%AA

这个贴子有看到，感觉太长了，想用cmd写的短一点。

llsheng_73

nyistjz 发表于 2024-11-9 19:25
这个贴子有看到，感觉太长了，想用cmd写的短一点。

我是把REGIONT复制到块里边去分解，然后取所有线段的首尾点坐标来进行串线的，不过由于自己使用情况不会涉及到凸度，所以意义不太大

llsheng_73

你这里应该主要是差一个自动转换。。。。


PEDITACCEPT 系统变量

禁止在 PEDIT 中显示“选定的对象不是多段线”提示。 该提示后会显示“是否将其转换为多段线？” 输入 y 可将选定对象转换成多段线。 当该提示被禁止显示时，选定对象将自动转换为多段线。

0

显示提示

1

抑制提示

nyistjz

(defun c:gg()
    (setq x(entlast))
    (setq ss (ssget))
    (while (setq s (ssget "p"))
        (command-s "explode" s "")
    )

(setq cm (getvar "cmdecho"))
(setvar'cmdecho 0) ;指令执行过程不响应
(setvar 'peditaccept 1) ;加入这个系统变量的代码,转化为多段线
(command-s "pedit" "m" (i:newss x) "" "J" "J" "E" 0 "")
(setvar "cmdecho" cm)

)

;获取在图元 en 之后产生的选择集 caoyin 2009-1-5 http://bbs.mjtd.com/thread-73098-1-1.html
(defun i:newss(en / ss) ;(setq x(entlast)) (if (i:newss x)  ) ;判断新图元
(if en (progn
(setq ss (ssadd)) ;建立空集
(while (setq en (entnext en)) ;当en后有对象时
(if (not (member (cdr (assoc 0 (entget en))) '("ATTRIB" "VERTEX" "SEQEND"))) (ssadd en ss) ) ) ;把en后的对象加入到空集
(if (zerop (sslength ss)) (setq ss nil))
ss)
(ssget "x")
) )


;;==============================================




(defun c:gg()
    (setq ss (ssget))
                (setq s00 (entlast))
                (setq ssss (ssadd))
                (command "select" ss "")
                (setq sss (ssget "p" '((0 . "region"))))
    (while (and sss (> (sslength sss) 0))
                                (setq s0 (entlast))
                                (command-s "explode" sss "")
                               
                                (while (and (setq s0 (entnext s0))
                                                                 (setq xx (entget s0))
                                                                 (not (wcmatch (cdr (assoc 0 xx)) "VERTEX,SEQEND,ATTRIB"))
                                                         )
                                        (ssadd s0 sss)
                                )
                        (command "select" sss "")
                        (setq sss (ssget "p" '((0 . "region"))))
    )       
                (while (and (setq s00 (entnext s00))
                                                                 (setq xx (entget s00))
                                                                 (not (wcmatch (cdr (assoc 0 xx)) "VERTEX,SEQEND,ATTRIB"))
                                                         )
                                        (ssadd s00 ssss)
                                )                  
    (command-s "pedit" "m" ssss "" "J" "J" "E" 0 "")
)

nyistjz

xyp1964 发表于 2024-11-10 11:09

不是源码，对学习和讨论没啥用。