jpg102329 发表于 2017-8-16 15:25:47

面域转多段线

本帖最后由 jpg102329 于 2017-8-21 08:11 编辑


;除spline转的面域
;16:39 2017/7/28
【唐僧】晗子轩(515357067) 16:38:49
;;;函数名称:SWH-ent-region->curve
;;;函数说明:面域转多段线
;;;参    数:lst:面域选择集(可以是多个面域模式)
;;;返 回 值:转换后的图元名lst
;;;示    例:(setq bbb(SWH-ent-region->curve (setq lst(ssget))))
(defun SWH-ent-region->curve (lst / cl lastent lste lt:ss-entnext objl ss ss->ents ssc swh-select-ss->ents)
;;125.2 [功能] 获取在图元 en 之后产生的图元的选择集--by黄大师
(defun lt:ss-entnext (en / ss)
(if en
(progn
(setq ss (ssadd))
(while (setq en (entnext en))
(if (not (member (cdr (assoc 0 (entget en)))
'("ATTRIB"
"VERTEX"
"SEQEND"
)
)
)
(ssadd en ss)
)
)
(cond((zerop (sslength ss)) (setq ss nil)))
ss
)
(ssget "_x")
)
)
(defun SWH-select-ss->ents (ss / el i sl)
    (setq
sl (sslength ss)
i-1
    )
    (repeat sl
      (setq el (cons (ssname ss (setq i (1+ i))) el))
    )
    el
)
(setq lastent(entlast))
(setq ss (ssadd))
(setq ssc(ssadd))
(if (= (type lst) 'PICKSET)
    (setq lste (SWH-select-ss->ents lst))
)
(setq
    cl (mapcar
         '(lambda (a)
            (mapcar 'vlax-vla-object->ename(safearray-value (variant-value a)))
          )
         (mapcar'vla-explode
         (mapcar
             'vlax-ename->vla-object
             (vl-remove-if'(lambda (x) (/= (cdr (assoc 0 (entget x))) "REGION"))lste)
         )
         )
       )
)
(foreach x cl(foreach y x (ssadd y ss)))
(vl-cmdf "PEDIT" "m" ss "" "Y" "J" 0 "")
(setq ssc(SWH-select-ss->ents(lt:ss-entnext lastent)))
)

<以上内容出自《大海语录》不代表本人观点>

欢迎加入通信管线设计技术交流群655280537，通信管线规划设计技术、资源交流群，CAD底图交换、付费教程免费获取、交流经验、互相学习，共同进步！





刘玉良 发表于 2018-3-5 14:16:43

改成这样
(defun C:RTP()
(setq S0 (entsel "\n请点选目标对象:"))
(COMMAND "layer" "n" "defpoints" "c" "7" "defpoints" "s" "defpoints" "p" "p" "defpoints" "" "chprop" S0 "" "la" "defpoints" "")
(COMMAND "EXPLODE" S0 "")
(setq RSS (ssget "x" '((0 . "LINE,ARC,*POLYLINE")(8 . "defpoints"))))
(COMMAND "PEDIT" "M" RSS "" "Y" "J" "0" ""))

比n还多 发表于 2018-2-7 15:31:34

(defun C:RTP()
(setq S0 (entsel "\n请点选目标对象:"))
(COMMAND "layer" "n" "defpoints" "c" "7" "defpoints" "s" "defpoints" "p" "p" "defpoints" "" "chprop" S0 "" "la" "defpoints" "")
(COMMAND "EXPLODE" S0 "")
(setq RSS (ssget "x" '((0 . "LINE,ARC,*POLYLINE")(8 . "defpoints"))))
(COMMAND "PEDIT" "M" RSS "" "Y" "J" "0" "")）

yansu 发表于 2018-2-9 14:43:51

win8.1，64位cad2012楼上的两个程序都提示 命令: ; 错误: 输入的列表有缺陷

434939575 发表于 2017-8-26 20:25:48

大师怎么2007运行炸开了

1028882406@qq.c 发表于 2017-8-27 15:47:57

谢谢楼主，支持下

LIULISHENG 发表于 2017-9-23 17:57:40

真的有用处啊

lioun4105 发表于 2017-11-25 23:59:20

好东西，谢谢

逍遥天下 发表于 2017-11-26 19:09:36

路过，顶顶顶

半夜星星 发表于 2018-2-4 11:16:05

怎么出错了啊

比n还多 发表于 2018-2-6 21:10:21

太长了，明天把我的发来看看
页: [1] 2
查看完整版本: 面域转多段线