明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1791|回复: 12

[源码] 求助:根据z值连接多段线的代码

[复制链接]
发表于 2014-9-12 13:35 | 显示全部楼层 |阅读模式
我写了一个简单的根据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)
)
"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2014-9-12 13:48 | 显示全部楼层
写好这个代码不容易,我至今还是用overkill
 楼主| 发表于 2014-9-12 14:00 | 显示全部楼层
自贡黄明儒 发表于 2014-9-12 13:48
写好这个代码不容易,我至今还是用overkill

黄老师  能不能  你给看看代码 条件判断是不是不对啊
发表于 2014-9-12 14:17 | 显示全部楼层
本帖最后由 自贡黄明儒 于 2014-9-12 14:37 编辑
杜阳 发表于 2014-9-12 14:00
黄老师  能不能  你给看看代码 条件判断是不是不对啊

;;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 22:12 | 显示全部楼层
自贡黄明儒 发表于 2014-9-12 14:17
;;164.29 [功能] 连接线、弧成多段线
;;(HH:JionToPolyline)
(defun HH:JionToPolyline (/ PET SS)

谢谢黄老师百忙之中给予解答,可是我实验 光有选线  其他的就不执行了
发表于 2014-9-13 02:04 | 显示全部楼层
这个单靠Z值相等来判断,我觉得不合理,如果两条线相隔较远,那是不是会出错?
这里提供以前找到的,现在不知道是那个高手编的,仅供参考
  1. ;;智能连接线
  2. (defun c:BJ_CurveJoin ( / ss pda en fuzz val)
  3.   (vl-load-com)
  4.   (setq val (getvar "cmdecho"))
  5.   (setvar "cmdecho" 0)
  6.   (princ (strcat "\n请选择线"))
  7.   (if (and (setq en (car (entsel "\n选择第一条线:")))
  8.            (wcmatch (cdr (assoc 0 (entget en))) "ARC,LINE,*POLYLINE")
  9.            (setq en (vlax-ename->vla-object en))
  10.            (/= "AcDb3dPolyline" (vla-get-ObjectName en))
  11.       )
  12.       (progn
  13.          (if (null (setq fuzz (getdist "\n输入模糊距离<0>: ")))
  14.              (setq fuzz 0)
  15.          )
  16.          (setq ss (ssadd)) ;创建新的选择集
  17.          (foreach item
  18.             (setq lst (ChainSelectFromAny en (+ fuzz 1e-6)))
  19.             (ssadd (vlax-vla-object->ename item) ss)
  20.          )
  21.          (mip:mark)
  22.          (vl-catch-all-apply
  23.              '(lambda ()
  24.                 (if (setq pda (getvar "PEDITACCEPT"))
  25.                     (progn
  26.                        (setq pda (getvar "peditaccept"))
  27.                        (setvar "peditaccept" 1)
  28.                        (command "_pedit" "_M" ss "" "_j" "_j" "_b" fuzz "")
  29.                        (setvar "peditaccept" pda)
  30.                     )
  31.                     (command "_pedit" "_M" ss "" "_Y" "_j" "_j" "_b" fuzz "")
  32.                 )
  33.               )
  34.          )
  35.          (setq lst (vl-remove-if 'vlax-erased-p lst))
  36.          (if (setq ss nil ss (mip:get-last-ss))
  37.              (progn
  38.                 (if lst (foreach item lst (ssadd (vlax-vla-object->ename item) ss)))
  39.                 (setq fuzz 0)
  40.                 (while (setq en (ssname ss fuzz))
  41.                     (if (/= (cdr (assoc 0 (entget en))) "LWPOLYLINE")
  42.                         (ssdel en ss)
  43.                         (setq fuzz (1+ fuzz))
  44.                     )
  45.                 )
  46.                 (sssetfirst ss ss)
  47.              )
  48.          )
  49.          (setq ss nil)
  50.       )
  51.       (princ "\n需选择LINE, ARC or Polyline")
  52.   )
  53.   (setvar "cmdecho" val)
  54.   (princ)
  55. )
  56. (defun ChainSelectFromAny (pt fuzz / chain_list couple ept line_list ln loop pda spt ss ln1 cycl)
  57.   (vl-load-com)
  58.   (cond
  59.     ((= (type pt) 'ENAME)
  60.         (setq ln (vlax-ename->vla-object pt)
  61.               pt nil
  62.         )
  63.     )
  64.     ((= (type pt) 'VLA-OBJECT)
  65.       (setq ln pt pt nil)
  66.     )
  67.     (t nil)
  68.   )
  69.   (if (setq ss (ssget "_I") ss nil ss (ssget "_X" '((0 . "ARC,LINE,*POLYLINE"))))
  70.       (progn
  71.          (if pt
  72.            (progn
  73.               (setq ln1
  74.                  (vla-addLine
  75.                      (if (and (zerop (vla-get-ActiveSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
  76.                               (= :vlax-false (vla-get-MSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
  77.                          )
  78.                          (vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
  79.                          (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
  80.                      )
  81.                      (vlax-3D-point pt)
  82.                      (vlax-3D-point (mapcar '- pt '(1 1 0)))
  83.                  )
  84.               )
  85.               (setq ln ln1)
  86.            )
  87.          )
  88.          (setq spt (vlax-curve-getStartPoint ln)
  89.                ept (vlax-curve-getEndPoint ln)
  90.          )
  91.          (setq line_list (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
  92.                chain_list nil
  93.                chain_list (cons ln chain_list)
  94.          )
  95.          (setq line_list (vl-remove-if '(lambda (x) (eq "AcDb3dPolyline" (vla-get-ObjectName x))) line_list))
  96.          (setq loop t cycl 0)
  97.          (while loop
  98.            (while
  99.               (setq couple
  100.                  (vl-remove-if-not
  101.                     (function (lambda (x)
  102.                                 (or (equal (vlax-curve-getStartPoint x) (vlax-curve-getStartPoint ln) fuzz)
  103.                                     (equal (vlax-curve-getStartPoint x) (vlax-curve-getEndPoint ln) fuzz)
  104.                                     (equal (vlax-curve-getEndPoint x) (vlax-curve-getStartPoint ln) fuzz)
  105.                                     (equal (vlax-curve-getEndPoint x) (vlax-curve-getEndPoint ln) fuzz)
  106.                                 )
  107.                               )
  108.                     )
  109.                     line_list
  110.                  )
  111.               )
  112.               (grtext -1 (strcat "正在连线,请稍等 - " (itoa (setq cycl (1+ cycl)))))
  113.               (if couple
  114.                  (progn
  115.                     (setq chain_list (append couple chain_list))
  116.                     (setq line_list (vl-remove ln line_list))
  117.                     (setq ln (car chain_list))
  118.                  )
  119.                  (setq line_list (cdr line_list))
  120.               )
  121.            )
  122.            (setq loop nil)
  123.          )
  124.       )
  125.   )
  126.   (setq chain_list (vl-remove ln1 chain_list))
  127.   (if (= (type ln1) 'VLA-OBJECT)
  128.       (vl-catch-all-apply 'vla-erase (list ln1))
  129.   )
  130.   (vl-cmdf "_.redraw")
  131.   chain_list
  132. )
  133. (defun mip:mark (/ val)
  134.   (setq val (getvar "cmdecho")) (setvar "cmdecho" 0)
  135.   (if (setq *mip:mark (entlast)) nil
  136.       (progn (entmake '((0 . "point") (10 0.0 0.0 0.0)))
  137.              (setq *mip:mark (entlast))
  138.              (entdel *mip:mark)
  139.       )
  140.   )
  141.   (setvar "cmdecho" val)
  142.   (princ)
  143. )
  144. (defun mip:get-last-ss (/ ss tmp val)
  145.   (setq val (getvar "cmdecho"))
  146.   (setvar "cmdecho" 0)
  147.   (if *mip:mark
  148.      (progn
  149.         (setq ss (ssadd))
  150.         (while
  151.            (setq *mip:mark (entnext *mip:mark))
  152.            (ssadd *mip:mark ss)
  153.         )
  154.         (command "._select" ss "")
  155.         (setq tmp ss ss nil)
  156.      )
  157.      (alert "*mip:mark not set. \n run (mip:mark) before mip:get-last-ss.")
  158.   )
  159.   (setvar "cmdecho" val)
  160.   tmp
  161. )
 楼主| 发表于 2014-9-13 10:45 | 显示全部楼层
gzxl 发表于 2014-9-13 02:04
这个单靠Z值相等来判断,我觉得不合理,如果两条线相隔较远,那是不是会出错?
这里提供以前找到的,现在不 ...

谢谢 gzxl老师的指导,使用了一下  没有实现任何结果  我再学习一下吧  谢谢老师
发表于 2014-9-13 14:14 | 显示全部楼层

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
 楼主| 发表于 2014-9-13 15:44 | 显示全部楼层
xyp1964 发表于 2014-9-13 14:14

呵呵  院长  你可来了 呵呵  把你的代码发出来  学习吧   就是你平常用的代码就行  
发表于 2014-9-13 17:19 | 显示全部楼层
gzxl 发表于 2014-9-13 02:04
这个单靠Z值相等来判断,我觉得不合理,如果两条线相隔较远,那是不是会出错?
这里提供以前找到的,现在不 ...

这个确实很实用。
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 21:05 , Processed in 0.247397 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表