cjjh8301 发表于 2015-6-17 11:42:20

闭合平行线！

求小程序，能闭合2条平行的多段线！

叮咚 发表于 2015-6-17 11:42:21

(vl-load-com)
(defun lwpts(lwen / lwdt)
        (setq lwdt (entget lwen))
        (vl-remove-if-not '(lambda(e1) (equal (car e1) 10)) lwdt)
)
(defun c:bh()
        (prompt "\nSelect 2 lwpolylines:")
        (setq ss (ssget '((0 . "lwpolyline"))))
        (or ss (setq ss (ssadd)))
        (setq len (sslength ss) m 0)
        (if (/= len 2)
                (princ "\n不是2根! ---程序退出......")
                (progn
                        (setq en1 (ssname ss 0) en2 (ssname ss 1))
                        (setq data1 (lwpts en1) data2 (lwpts en2))
                        (setq pt1 (cdar data1) pt2 (cdr (last data1)))
                        (setq pt3 (cdar data2) pt4 (cdr (last data2)))
                        (setq dis1 (distance pt1 pt3) dis2 (distance pt1 pt4))
                        (if (> dis1 dis2)(setq ptx pt3 pt3 pt4 pt4 ptx ptx nil))
                        (entmake (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt3)))
                        (setq ss (ssadd (entlast) ss))
                        (entmake (list '(0 . "LINE") (cons 10 pt2) (cons 11 pt4)))
                        (setq ss (ssadd (entlast) ss))
                        (setvar "cmdecho" 0)
                        (setvar "peditaccept" 1)
                        (command "pedit" "m"ss "" "j" "" "")
                        (setvar "peditaccept" 0)
                        (setvar "cmdecho" 1)
                )
        )
        (princ)
)

yunfengning 发表于 2015-6-21 11:12:31

不错，但能不能改成支持LINE线？

cjjh8301 发表于 2015-6-24 09:19:56

可以了谢谢！

cjjh8301 发表于 2015-6-24 09:22:20

能不能加点，闭合后同时填充上，图案名称是ANSI36那个！

ZZXXQQ 发表于 2015-6-24 14:59:33

本帖最后由 ZZXXQQ 于 2015-6-26 08:07 编辑

cjjh8301 发表于 2015-6-24 09:22 http://bbs.mjtd.com/static/image/common/back.gif
能不能加点，闭合后同时填充上，图案名称是ANSI36那个！(vl-load-com)
(defun lwpts (lwen)
(vl-remove-if-not '(lambda(a) (= (car a) 10)) (entget lwen))
)
(defun c:bh()
(prompt "\nSelect 2 lwpolylines:")
(if (and (setq ss (ssget '((0 . "LWPOLYLINE"))))
          (= (sslength ss) 2)) (progn
(setq en1 (ssname ss 0) en2 (ssname ss 1))
(setq data1 (lwpts en1) data2 (lwpts en2))
(setq pt1 (cdar data1) pt2 (cdr (last data1)))
(setq pt3 (cdar data2) pt4 (cdr (last data2)))
(setq dis1 (distance pt1 pt3) dis2 (distance pt1 pt4))
(if (> dis1 dis2)(setq ptx pt3 pt3 pt4 pt4 ptx ptx nil))
(entmake (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt3)))
(ssadd (entlast) ss)
(entmake (list '(0 . "LINE") (cons 10 pt2) (cons 11 pt4)))
(ssadd (entlast) ss)
(setvar "cmdecho" 0)
(setvar "peditaccept" 1)
(command "_.pedit" "m" ss "" "j" "" "")
(command "_.HATCH" "ANSI36" "" "" "L" "")
(setvar "peditaccept" 0)
(setvar "cmdecho" 1)
)
(princ "\n不是2根! ---程序退出......")
)
(princ)
)

cjjh8301 发表于 2015-6-25 08:12:49

ZZXXQQ 发表于 2015-6-24 14:59 static/image/common/back.gif


命令后 ，选不中线

yoyoho 发表于 2015-6-25 11:47:58

"LWPOYLINE"改"LWPOLYLINE"

cjjh8301 发表于 2015-6-25 12:34:53

yoyoho 发表于 2015-6-25 11:47 static/image/common/back.gif
"LWPOYLINE"改"LWPOLYLINE"

可以了，谢谢！
页: [1]
查看完整版本: 闭合平行线！