xd-xdcad 发表于 2012-11-13 11:53:07

求助：线段直线合并

本帖最后由 xd-xdcad 于 2012-11-13 11:54 编辑

附件程序一直用的不错，这段时间使用，为什么有时连接不成功呢？
附件功能是将首尾相连的直线、多段线、圆弧等合并成一个多段线整体

程序如下：
(defun l_to_pl (ssa / ss1 lines ent n)
(defun l_to_pl:main (/ ent ss1 n)
    (setq ent (ssname lines 0))
    (if        (member        (cdr (assoc 0 (entget ent)))
                '("POLYLINE" "LWPOLYLINE")
        )
      (if (/= 1 (logand (cdr (assoc 70 (entget ent))) 1))
        (command "._pedit" ent "j" lines "" "")
      )
      (command "._pedit" ent "y" "j" lines "" "")
    )
    (setq lines (ssdel ent lines))
    (setq ss1 (ssadd))
    (repeat (setq n (sslength lines))
      (setq ent (ssname lines (setq n (1- n))))
      (if (entget ent)
        (setq ss1 (ssadd ent ss1))
      )
    )
    (setq lines ss1)
    (while (> (sslength lines) 0) (l_to_pl:main))
)
(command "._undo" "be")
(setq ss1 (ssadd))
(repeat (setq n (sslength ssa))
    (setq ent (ssname ssa (setq n (1- n))))
    (if        (and (entget ent)
             (member (cdr (assoc 0 (entget ent)))
                     '("LINE" "ARC" "POLYLINE" "LWPOLYLINE")
             )
        )
      (setq ss1 (ssadd ent ss1))
    )
)
(setq lines ss1)
(l_to_pl:main)
(command "._undo" "e")
)

(defun c:lp (/ a)
(setq a (ssget))
(l_to_pl a)
;;;(l_to_pl lines)
;;;(while (> (sslength (setq lines (l_to_pl lines))) 0) (progn))
)


叮咚 发表于 2012-11-13 13:02:56

本帖最后由 叮咚 于 2012-11-13 13:04 编辑

(defun c:lx(/ olcm ss)
(setq olcm (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq ss (ssget '((0 . "line,lwpolyline,arc"))))
(if ss
(progn
(command "_pedit" "m" ss "")
(vl-catch-all-apply '(lambda()
(command "y")
))
(command "j" "" "")
)
(princ "\n未选择可用对象!")
)
(setvar "cmdecho" olcm)
(princ)
)

好像 polyline （三维多段线）不能合并

xd-xdcad 发表于 2012-11-13 14:14:47

叮咚 发表于 2012-11-13 13:02 static/image/common/back.gif
好像 polyline （三维多段线）不能合并

能够成功，但在命令行中总是显示“无效的选项关键字”？

phoenixdjq 发表于 2012-11-13 14:43:06

(defun c:ddd()

(setq ss (ssget "x" '((0 . "*LINE") (8 . "1"))))
(setq len (sslength ss))
(setq n 0)
(repeat len
(setq ent (ssname ss n))
(command "join" ent ss "" "")
(setq n (1+ n))
) ;end repeat

(setq old (getvar "peditaccept"))
(command "peditaccept" 1)
(setq a (car (entsel "\n 请选择一条直线:")))
(setq ss1 (ssget "x" '((0 . "*LINE") (8 . "1"))))
(command "chprop" ss1 "" "c" 3 "")
(command "pedit" a"j" ss1 "" "w" 0.5 "")
(setvar "peditaccept" old)
)

xd-xdcad 发表于 2012-11-13 14:46:08

phoenixdjq 发表于 2012-11-13 14:43 static/image/common/back.gif
(defun c:ddd()

(setq ss (ssget "x" '((0 . "*LINE") (8 . "1"))))


加载时提示参数类型错误，我的是CAD2004

phoenixdjq 发表于 2012-11-13 14:58:49

不好意思

(8 . "1")

我是定义的图层1中的线段

你可以去掉，或者改成别的层
页: [1]
查看完整版本: 求助：线段直线合并