求助：根据z值连接多段线的代码
我写了一个简单的根据z值连接多段线的代码，思路：先根据选择的两条线的z值判断来确定是否连接，如果z值相同就实现连接并拟合连接后的线，如果z值不等，就重新选择，可是代码实现的是：z值相等连接并拟合成同一条线，z值不等时，两条线只连接，不拟合，也不是一条线 是三段不同的线。望各位老师给予帮助。这段代码还有一个缺点就是，能不能根据两条线的相邻顶点进行连接，如果多段线的起始方向不合理，连接就不合理了。
学生在此感谢各位老师给予指导，谢谢。
一下是代码：
(Defun C:cjlj (/ Ss1 ss2 Pt1 Pt2 p1 p2)
(vl-load-com)
(Setvar "Cmdecho" 0)
(Setq Pt1 (Getvar "Vsmin"))
(Setq Pt2 (Getvar "Vsmax"))
(Setq Ss1 (Entsel "\n 选择1线:"))
(Setq Ss2 (Entsel "\n 选择2线:"))
(Setq p1 (vlax-curve-getendpoint (car ss1)))
(Setq p2 (vlax-curve-getstartpoint (car ss2)))
(setq Z1(car(assoc 38 (entget (car ss1)))))
(setq Z2(car(assoc 38 (entget (car ss2)))))
(if (= z1 z2)
(progn
(Vl-Cmdf "line" p1 p2 "")
(Vl-Cmdf ".Pedit" Ss1 "Yes" "J" "C" Pt1 Pt2 "" "" )
(Vl-Cmdf ".Pedit" Ss1 "Yes" "s" Pt1 Pt2 "" "")
)
)
(Setvar "Cmdecho" 1)
(Princ)
) 写好这个代码不容易，我至今还是用overkill 自贡黄明儒 发表于 2014-9-12 13:48 static/image/common/back.gif
写好这个代码不容易，我至今还是用overkill
黄老师能不能你给看看代码 条件判断是不是不对啊 本帖最后由 自贡黄明儒 于 2014-9-12 14:37 编辑
杜阳 发表于 2014-9-12 14:00 static/image/common/back.gif
黄老师能不能你给看看代码 条件判断是不是不对啊
;;164.29 [功能] 连接线、弧成多段线
;;(HH:JionToPolyline)
(defun HH:JionToPolyline (/ PET SS)
(setq pet (getvar "PEDITACCEPT"))
(setvar "PEDITACCEPT" 1)
(while (setq ss (ssget '((0 . "ARC,*LINE"))))
(command "_.pedit" (ssname ss 0) "j" ss "" "")
)
(setvar "PEDITACCEPT" pet)
(princ)
)
;;假如我要写的话，可能会这样
(Defun C:cjlj (/ PET SS1 SS2 Z1)
(vl-load-com)
(setq pet (getvar "PEDITACCEPT"))
(setvar "PEDITACCEPT" 1)
(Setq Ss1 (Entsel "\n 选择1线:"))
(setq Z1 (car (assoc 38 (entget (car ss1)))))
(Setq Ss2 (ssget (list '(0 . "ARC,*LINE") (cons 38 Z1))))
(command "_.pedit" (ssname ss2 0) "j" ss2 "" "")
(setvar "PEDITACCEPT" pet)
(princ)
) 自贡黄明儒 发表于 2014-9-12 14:17 static/image/common/back.gif
;;164.29 [功能] 连接线、弧成多段线
;;(HH:JionToPolyline)
(defun HH:JionToPolyline (/ PET SS)
谢谢黄老师百忙之中给予解答，可是我实验 光有选线其他的就不执行了 这个单靠Z值相等来判断，我觉得不合理，如果两条线相隔较远，那是不是会出错？
这里提供以前找到的，现在不知道是那个高手编的，仅供参考;;智能连接线
(defun c:BJ_CurveJoin ( / ss pda en fuzz val)
(vl-load-com)
(setq val (getvar "cmdecho"))
(setvar "cmdecho" 0)
(princ (strcat "\n请选择线"))
(if (and (setq en (car (entsel "\n选择第一条线:")))
(wcmatch (cdr (assoc 0 (entget en))) "ARC,LINE,*POLYLINE")
(setq en (vlax-ename->vla-object en))
(/= "AcDb3dPolyline" (vla-get-ObjectName en))
)
(progn
(if (null (setq fuzz (getdist "\n输入模糊距离<0>: ")))
(setq fuzz 0)
)
(setq ss (ssadd)) ;创建新的选择集
(foreach item
(setq lst (ChainSelectFromAny en (+ fuzz 1e-6)))
(ssadd (vlax-vla-object->ename item) ss)
)
(mip:mark)
(vl-catch-all-apply
'(lambda ()
(if (setq pda (getvar "PEDITACCEPT"))
(progn
(setq pda (getvar "peditaccept"))
(setvar "peditaccept" 1)
(command "_pedit" "_M" ss "" "_j" "_j" "_b" fuzz "")
(setvar "peditaccept" pda)
)
(command "_pedit" "_M" ss "" "_Y" "_j" "_j" "_b" fuzz "")
)
)
)
(setq lst (vl-remove-if 'vlax-erased-p lst))
(if (setq ss nil ss (mip:get-last-ss))
(progn
(if lst (foreach item lst (ssadd (vlax-vla-object->ename item) ss)))
(setq fuzz 0)
(while (setq en (ssname ss fuzz))
(if (/= (cdr (assoc 0 (entget en))) "LWPOLYLINE")
(ssdel en ss)
(setq fuzz (1+ fuzz))
)
)
(sssetfirst ss ss)
)
)
(setq ss nil)
)
(princ "\n需选择LINE, ARC or Polyline")
)
(setvar "cmdecho" val)
(princ)
)
(defun ChainSelectFromAny (pt fuzz / chain_list couple ept line_list ln loop pda spt ss ln1 cycl)
(vl-load-com)
(cond
((= (type pt) 'ENAME)
(setq ln (vlax-ename->vla-object pt)
pt nil
)
)
((= (type pt) 'VLA-OBJECT)
(setq ln pt pt nil)
)
(t nil)
)
(if (setq ss (ssget "_I") ss nil ss (ssget "_X" '((0 . "ARC,LINE,*POLYLINE"))))
(progn
(if pt
(progn
(setq ln1
(vla-addLine
(if (and (zerop (vla-get-ActiveSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
(= :vlax-false (vla-get-MSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
)
(vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(vlax-3D-point pt)
(vlax-3D-point (mapcar '- pt '(1 1 0)))
)
)
(setq ln ln1)
)
)
(setq spt (vlax-curve-getStartPoint ln)
ept (vlax-curve-getEndPoint ln)
)
(setq line_list (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
chain_list nil
chain_list (cons ln chain_list)
)
(setq line_list (vl-remove-if '(lambda (x) (eq "AcDb3dPolyline" (vla-get-ObjectName x))) line_list))
(setq loop t cycl 0)
(while loop
(while
(setq couple
(vl-remove-if-not
(function (lambda (x)
(or (equal (vlax-curve-getStartPoint x) (vlax-curve-getStartPoint ln) fuzz)
(equal (vlax-curve-getStartPoint x) (vlax-curve-getEndPoint ln) fuzz)
(equal (vlax-curve-getEndPoint x) (vlax-curve-getStartPoint ln) fuzz)
(equal (vlax-curve-getEndPoint x) (vlax-curve-getEndPoint ln) fuzz)
)
)
)
line_list
)
)
(grtext -1 (strcat "正在连线，请稍等 - " (itoa (setq cycl (1+ cycl)))))
(if couple
(progn
(setq chain_list (append couple chain_list))
(setq line_list (vl-remove ln line_list))
(setq ln (car chain_list))
)
(setq line_list (cdr line_list))
)
)
(setq loop nil)
)
)
)
(setq chain_list (vl-remove ln1 chain_list))
(if (= (type ln1) 'VLA-OBJECT)
(vl-catch-all-apply 'vla-erase (list ln1))
)
(vl-cmdf "_.redraw")
chain_list
)
(defun mip:mark (/ val)
(setq val (getvar "cmdecho")) (setvar "cmdecho" 0)
(if (setq *mip:mark (entlast)) nil
(progn (entmake '((0 . "point") (10 0.0 0.0 0.0)))
(setq *mip:mark (entlast))
(entdel *mip:mark)
)
)
(setvar "cmdecho" val)
(princ)
)
(defun mip:get-last-ss (/ ss tmp val)
(setq val (getvar "cmdecho"))
(setvar "cmdecho" 0)
(if *mip:mark
(progn
(setq ss (ssadd))
(while
(setq *mip:mark (entnext *mip:mark))
(ssadd *mip:mark ss)
)
(command "._select" ss "")
(setq tmp ss ss nil)
)
(alert "*mip:mark not set. \n run (mip:mark) before mip:get-last-ss.")
)
(setvar "cmdecho" val)
tmp
) gzxl 发表于 2014-9-13 02:04 static/image/common/back.gif
这个单靠Z值相等来判断，我觉得不合理，如果两条线相隔较远，那是不是会出错？
这里提供以前找到的，现在不 ...
谢谢 gzxl老师的指导，使用了一下没有实现任何结果我再学习一下吧谢谢老师
xyp1964 发表于 2014-9-13 14:14 static/image/common/back.gif
呵呵院长你可来了 呵呵把你的代码发出来学习吧 就是你平常用的代码就行 gzxl 发表于 2014-9-13 02:04 static/image/common/back.gif
这个单靠Z值相等来判断，我觉得不合理，如果两条线相隔较远，那是不是会出错？
这里提供以前找到的，现在不 ...
这个确实很实用。
页:
[1]
2