请帮忙改改程序.

csharp · 发表于 2014-11-13 10:06:16

(if (setq ss (ssget "x" '((0 . "lwpolyline") (8 . "2"))))
  (progn
(setq sl (sslength ss))
(while (setq e (ssname ss (setq sl (1- sl))))
   (vl-cmdf ".explode" e)
)
  )
)

newer · 发表于 2014-11-13 11:02:32

csharp 发表于 2014-11-13 10:06
(if (setq ss (ssget "x" '((0 . "lwpolyline") (8 . "2"))))
(progn
(setq sl (sslength ss))

选择集直接炸开不就行了，还用循环每个实体炸开吗？

守仁格竹GM · 发表于 2014-11-13 11:22:04

本帖最后由守仁格竹GM 于 2014-11-13 13:25 编辑

(defun c:pjj ( / pedit-m)
(defun pedit-m (ss / )
(setvar "peditaccept" 1)
(command "_.Pedit" "_m" ss "" "_j" "" "")
)
(princ "\n 本程序用来批量连接线段")
(pedit-m (ssget '((-4 . "<OR")
(0 . "LINE")(0 . "ARC")
(-4 . "<AND")(0 . "LWPOLYLINE,POLYLINE")(70 . 0)(-4 . "AND>")
(-4 . "OR>")))
)
(princ)
)

(defun c:tt( / ss sj-lst)
(setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE")(70 . 1))))
(setq
sj-lst
(mapcar
'(lambda(x / lst)
(setq lst(xdrx_GetPropertyValue x "BoundingBox"))
(list (cdr (vl-sort
(mapcar 'abs (apply 'mapcar (cons '- lst)))
'<
)
)
(apply 'xdrx_line_midp lst)
)
)
(xdrx_pickset->ents ss)
)
)
(setq sj-lst (XD::List:GroupByIndex sj-lst 0))
)

这个列表就是你需要的了，剩下的自己就可以处理了，
sj-lst 的数值为（
                        （（长1 宽1）（中心点1）（中心点2））
                        （（长2 宽2）（中心点3）（中心点4））
                        ）

st788796 · 发表于 2014-11-13 11:27:38

newer 发表于 2014-11-13 11:02
选择集直接炸开不就行了，还用循环每个实体炸开吗？

Autolisp 中的 command explode 受 qaflags 变量影响，但是 2004 下这个变量楼主使用有问题，只好一个个 explode

st788796 · 发表于 2014-11-13 11:29:14

守仁格竹GM 发表于 2014-11-13 11:22
(defun c:pjj ( / pedit-m)
(defun pedit-m (ss / )
(setvar "peditaccept" 1)

既然使用 API，还可以更简单，上面有一段代码可以看看

newer · 发表于 2014-11-13 12:08:01

st788796 发表于 2014-11-13 11:27
Autolisp 中的 command explode 受 qaflags 变量影响，但是 2004 下这个变量楼主使用有问题，只好一 ...

那难道说2004下面，就不能选择实体到选择集然后用EXPLODE炸开了，我想显然是不应该的。楼主应该在自己系统上找找原因。

iLisp · 发表于 2014-11-13 12:47:41

楼主只要有"抓到老鼠的猫"就够了

守仁格竹GM · 发表于 2014-11-13 13:16:29

st788796 发表于 2014-11-13 11:29
既然使用 API，还可以更简单，上面有一段代码可以看看

调整了一下{:soso_e100:}

pking5465 · 发表于 2014-11-13 14:17:56

这个比较高深，目前看着吃力。

st788796 · 发表于 2014-11-13 16:06:15

守仁格竹GM 发表于 2014-11-13 13:16
调整了一下

把选集往里一丢，返回( ((长1 宽1) 中心1 中心2 ...) ...) ，仅对和轴平行矩形

(defun GetRectang (ss / lst)
(xdrx_curve_join ss)
(setq lst (mapcar '(lambda (x / pts)
(if (setq pts (xd::polyline:isRectang x))
(progn
(setq pts (vl-sort
pts
'(lambda (x1 x2)
(if
(equal (cadr x1) (cadr x2) 1e-3)
(< (car x1) (car x2))
(< (cadr x1) (cadr x2))
)
)
)
)
(list (list (distance (car pts) (cadr pts))
(distance (car pts) (caddr pts))
)
(xdrx_line_midp (car pts) (caddr pts))
)
)
)
)
(xdrx_pickset->ents ss)
)
lst (xd::list:groupbyindex lst 1e-3)
)
)
(defun XD::Polyline:IsRectang (e / pts p1 p2 p3 p4)
(if (and (= (xdrx_getpropertyvalue e "IsA") "AcDbPolyline")
(setq pts (xdrx_geom_searchoutline e))
(= (length pts) 5)
(mapcar 'set '(p1 p2 p3 p4) pts)
(equal (distance p1 p3) (distance p2 p4) 1e-8)
(equal (xdrx_line_midp p1 p3) (xdrx_line_midp p2 p4) 1e-8)
)
(list p1 p2 p3 p4)
)
)

(defun GetRectang (ss / lst) 
  (xdrx_curve_join ss) 
  (setq        lst (mapcar '(lambda (x / pts) 
                       (if (setq pts (xd::polyline:isRectang x)) 
                         (progn 
                           (setq pts (vl-sort 
                                       pts 
                                       '(lambda        (x1 x2) 
                                          (if 
                                            (equal (cadr x1) (cadr x2) 1e-3) 
                                             (< (car x1) (car x2)) 
                                             (< (cadr x1) (cadr x2)) 
                                          ) 
                                        ) 
                                     ) 
                           ) 
                           (list (list (distance (car pts) (cadr pts)) 
                                       (distance (car pts) (caddr pts)) 
                                 ) 
                                 (xdrx_line_midp (car pts) (caddr pts)) 
                           ) 
                         ) 
                       ) 
                     ) 
                    (xdrx_pickset->ents ss) 
            ) 
        lst (xd::list:groupbyindex lst 1e-3) 
  ) 
) 
(defun XD::Polyline:IsRectang (e / pts p1 p2 p3 p4) 
  (if (and (= (xdrx_getpropertyvalue e "IsA") "AcDbPolyline") 
           (setq pts (xdrx_geom_searchoutline e)) 
           (= (length pts) 5) 
           (mapcar 'set '(p1 p2 p3 p4) pts) 
           (equal (distance p1 p3) (distance p2 p4) 1e-8) 
           (equal (xdrx_line_midp p1 p3) (xdrx_line_midp p2 p4) 1e-8) 
      ) 
    (list p1 p2 p3 p4) 
  ) 
)

abc498091367 · 发表于 2014-11-13 17:10:13

太多，慢慢理解！

abc498091367 · 发表于 2014-11-13 17:14:36

csharp 发表于 2014-11-13 10:06
(if (setq ss (ssget "x" '((0 . "lwpolyline") (8 . "2"))))
(progn
(setq sl (sslength ss))

就是要这效果，真心谢谢！{:soso_e163:}{:soso_e163:}

守仁格竹GM · 发表于 2014-11-14 08:12:27

abc498091367 发表于 2014-11-13 17:14
就是要这效果，真心谢谢！

你那程序太麻烦了，看看按照矩形的做法吧。回复楼上有两个都可以用

abc498091367 · 发表于 2014-11-14 12:14:31

恩，谢谢各位！{:soso_e163:}{:soso_e163:}

账号		自动登录	找回密码
密码			立即注册

[求助] 请帮忙改改程序.

点评

点评

点评

点评