【转帖】多义线焊接
 

多义线焊接
www.dimcax.com
多义线焊接
程序名称：typolylinejoin (
< 桐阳模具cad>
< ://tymoju.blogspot.com>

不错！是用什么语言写的？

编辑多段线命令pedit原就可以连接线段，楼主的插件只是便捷而已

什么好东西啊？看看先
勤能补拙

怎么现在发的东西都是编过的，不可以发lisp吗？
勤能补拙

效果相当不理想!
勤能补拙

(defun c:ct () (command "pedit" "m" (ssget) "" "y" "j" "j" "b" "0.00000" ""))
上传源代码。建议给我+威望。
只要输入ct就行了。快捷命令自己改

:
不错！是用什么语言写的？
谢谢支持，是用lisp写的，然后进行了编译。
< 桐阳模具cad>
< ://tymoju.blogspot.com>

:
怎么现在发的东西都是编过的，不可以发lisp吗？
请原谅，我只是为了提醒大家注意我的网站而已，如果有人对源代码感兴趣，可以和我联系。
本程序的源代码在下面。
(defun c:typlj (/ old-ucsname old-osmode)
(defun *error* (s)
;;; (setvar "pickbox" 10);本人喜欢把选择指示光标放的稍大一些,
;发给大家时去掉了
;;; (vl-cmdf "dimlfac" 1)
(vl-cmdf "ortho" "on")
(setvar "osmode" old-osmode)
;;; (setvar "ucsname" old-usename)
(prin1)
)
(defun main_polylinejoin (/ ss ss1 l e1-dxf e1-type p p1 p2 open-close obj1 isclose)
(vl-cmdf "ucs" "w")
(setq ss (ssget))
(setq e1-dxf (entget (ssname ss 0)))
(cond ((= (sslength ss) 1)
(setq p (getvar "viewctr"))
(setq p1 (polar p (* pi 1.25) 1000)
p2 (polar p (* pi 0.25) 1000)
)
(vl-cmdf "zoom" "w" p1 p2)
(setq ss1 (ssget "c" p1 p2))
(vl-cmdf "zoom" "p")
)
(t (setq ss1 ss))
)
(setq e1-type (cdr (assoc 0 e1-dxf)))
(if (wcmatch e1-type "*polyline")
(setq open-close (cdr (assoc 70 e1-dxf)))
(setq open-close nil)
)
(cond ((equal open-close 0) (vl-cmdf "pedit" ss "j" ss1 "" ""))
((equal open-close 1))
(t (vl-cmdf "pedit" ss "y" "j" ss1 "" ""))
)
(setq s1 (ssget "l")
e1 (ssname s1 0)
e1-dxf (entget e1)
obj1 (vlax-ename->vla-object e1)
isclosed (vla-get-closed obj1) ;是否闭合
)
(if (equal isclosed :vlax-true)
(print "polyline is close...")
(print "polyline not close...")
)
(setq p1 (vlax-safearray->list (vlax-variant-value (vla-get-coordinate obj1 0)))
p2 (vlax-safearray->list (vlax-variant-value (vla-get-coordinate obj1 1)))
)
(grdraw p1 (polar p1 (+ (angle p1 p2) (* pi 0.50)) (/ (getvar "viewsize") 15.0)) 2)
(grdraw p1 (polar p1 (+ (angle p1 p2) (* pi 0.35)) (/ (getvar "viewsize") 50.0)) 2)
(grdraw p1 (polar p1 (+ (angle p1 p2) (* pi 0.65)) (/ (getvar "viewsize") 50.0)) 2)
(if (/= old-ucsname "")
(vl-cmdf "ucs" "r" old-ucsname)
)
)
(setq old-ucsname (getvar "ucsname")
old-osmode (getvar "osmode")
)
(princ "\nthank you for using tylisp.")
(princ "\nplease visit ://tymoju.blogspot.com/")
(print)
(main_polylinejoin)
(setvar "osmode" old-osmode)
;;; (setvar "ucsname" old-usename)
(princ)
)
< 桐阳模具cad>
< ://tymoju.blogspot.com>

:
(defun c:ct () (command "pedit" "m" (ssget) "" "y" "j" "j" "b" "0.00000" ""))
上传源代码。建议给我+威望。
只要输入ct就行了。快捷命令自己改
不伦不类朋友的程序，和我的相比有点不同：
（1）你的程序需要先构造选择集，即需要把要连接的目标全部选上——我的程序最大的好处就是只要点选其中一条直线或圆弧回车就可以了；
（2）请你试一下，你的程序是否可以将两条多义线连接成一条？
< 桐阳模具cad>
< ://tymoju.blogspot.com>

不知大家注意到没有，这个程序中有一点我感到不十分满意。请看程序中下面的片段：
(setq p (getvar "viewctr"))
(setq p1 (polar p (* pi 1.25) 1000)
p2 (polar p (* pi 0.25) 1000)
)
(vl-cmdf "zoom" "w" p1 p2)
(setq ss1 (ssget "c" p1 p2))
(vl-cmdf "zoom" "p")
这一段程序的作用，是把要连接的目标zoom到视区中来，以便于用ssget构造选择集，然后再zoom回去。这么做的原因，是因为用ssget的c方式，不能选上视区以外的目标。可这样以来，屏幕会有一下抖动。
请问那位朋友有办法解决这个问题？
< 桐阳模具cad>
< ://tymoju.blogspot.com>