源码无聊贴:xj(连接首尾相连线条成封闭多义线) --by 狂刀 2007.9

狂刀lxx · 发表于 2011-5-10 23:31:42

本帖最后由狂刀lxx 于 2011-5-10 23:34 编辑

请留意演示，有多分支选择gong neng
以下是源码，纯无聊抛砖引玉，有要修改完善者勿扰

;| xj(连接首尾相连线条成封闭多义线) --by 狂刀 2007.9
说明: 方式:单点一条,自动搜索，多分支提示.
|;
(defun c:xj (/ E ESS FIL OS P1 PA PX0 PX1 ROOP SS SS2 SSS SSS2 X ee)
(princ "\n 连接首尾相连线条成封闭多义线------by 狂刀 2007.9")
(command ".undo" "be")
(setq fil '((0 . "LINE,ARC,*POLYLINE"))
os (getvar "osmode")
pa (getvar "PEDITACCEPT")
ssend(ssadd))
(setvar "osmode" 0)
(setvar "PEDITACCEPT" 1)
;; 生成首尾相连选集.
(while (and (princ "\n 选形成多义线的其中一条边线 <退出>:")
(setq ss (ssget ":S" fil))
)
(setq sss (ssadd)
sss2(ssadd)
roop nil)
(setq e (ssname ss 0)
e0 e
p0 (vlax-curve-getstartpoint e)
p1(vlax-curve-getendpoint e))
(vlax-put (vlax-ename->vla-object e) 'color 1)
(ssadd e sss)
(subxj ee p0)
(subxj ee p1)
(command ".pedit" "m" sss "" "j" 0.01 "")
(setq ee (entlast))
(redraw ee 3)
;(vlax-put (vlax-ename->vla-object ee) 'color 3)
(ssadd ee ssend)
)
(mapcar '(lambda(x)(redraw x 4))(xss2lst ssend))
(setvar "PEDITACCEPT" pa)
(setvar "osmode" os)
(command ".undo" "e")
(princ)
)
;;
(defun subxj (EE p1 / PX0 PX1 ROOP X esss ess)
(setq e ee)
(while (and (setq ss2 (ssget "c" p1 p1 fil))
(not rooP)
)
(setq ess (xss2lst ss2)
esss(xss2lst sss))
(mapcar'(lambda(x)(setq ess(vl-remove x ess))) esss)
(if (not (member e0 ess))
(if (and ess (< 1 (length ess)))
(progn (mapcar '(lambda (x) (redraw x 3)) ess)
(setq e (car (entsel "\n 选择分支:")))
(mapcar '(lambda (x) (redraw x 4)) ess)
)
(setq e (car ess))
)
)
(if (and e (not (ssmemb e sss)))
(progn
(ssadd e sss)
(vlax-put (vlax-ename->vla-object e) 'color 1)
(setq px0 (vlax-curve-getstartpoint e)
px1 (vlax-curve-getendpoint e)
)
(if (equal p1 px0 1e-4)
(setq p1 px1)
(setq p1 px0)
)
)
(setq roop T)
)
)
)
;; 配套函数, 提取选集实体名列表.
(defun xss2lst (ss / i e lst)
(setq i -1)
(while (setq e (ssname ss (setq i (1+ i))))
(setq lst (cons e lst))
)
(reverse lst)
)

;| xj(连接首尾相连线条成封闭多义线) --by 狂刀 2007.9 
说明: 方式:单点一条,自动搜索，多分支提示. 
|; 
(defun c:xj (/ E ESS FIL OS P1 PA PX0 PX1 ROOP SS SS2 SSS SSS2 X ee) 
  (princ "\n 连接首尾相连线条成封闭多义线------by 狂刀 2007.9") 
  (command ".undo" "be") 
  (setq fil '((0 . "LINE,ARC,*POLYLINE")) 
os (getvar "osmode") 
pa (getvar "PEDITACCEPT") 
ssend(ssadd)) 
  (setvar "osmode" 0) 
  (setvar "PEDITACCEPT" 1) 
  ;; 生成首尾相连选集. 
  (while (and (princ "\n 选形成多义线的其中一条边线 <退出>:") 
       (setq ss (ssget ":S" fil)) 
  ) 
    (setq sss (ssadd) 
   sss2(ssadd) 
   roop nil) 
    (setq e (ssname ss 0) 
   e0 e 
   p0 (vlax-curve-getstartpoint e) 
   p1(vlax-curve-getendpoint e)) 
    (vlax-put (vlax-ename->vla-object e) 'color 1) 
    (ssadd e sss) 
    (subxj ee p0) 
    (subxj ee p1) 
    (command ".pedit" "m" sss "" "j" 0.01  "") 
    (setq ee (entlast)) 
    (redraw ee 3) 
    ;(vlax-put (vlax-ename->vla-object ee) 'color 3) 
    (ssadd ee ssend) 
  ) 
  (mapcar '(lambda(x)(redraw x 4))(xss2lst ssend)) 
  (setvar "PEDITACCEPT" pa) 
  (setvar "osmode" os) 
  (command ".undo" "e") 
  (princ) 
) 
;; 
(defun subxj (EE p1 / PX0 PX1 ROOP X esss ess) 
  (setq e ee) 
  (while (and (setq ss2 (ssget "c" p1 p1 fil)) 
  (not rooP) 
    ) 
      (setq ess (xss2lst ss2) 
     esss(xss2lst sss)) 
      (mapcar'(lambda(x)(setq ess(vl-remove x ess))) esss) 
      (if (not (member e0 ess)) 
(if (and ess (< 1 (length ess))) 
   (progn (mapcar '(lambda (x) (redraw x 3)) ess) 
   (setq e (car (entsel "\n 选择分支:"))) 
   (mapcar '(lambda (x) (redraw x 4)) ess) 
   ) 
   (setq e (car ess)) 
) 
      ) 
      (if (and e (not (ssmemb e sss))) 
(progn 
   (ssadd e sss) 
   (vlax-put (vlax-ename->vla-object e) 'color 1) 
   (setq px0 (vlax-curve-getstartpoint e) 
  px1 (vlax-curve-getendpoint e) 
   ) 
   (if (equal p1 px0 1e-4) 
     (setq p1 px1) 
     (setq p1 px0) 
   ) 
) 
(setq roop T) 
      ) 
    ) 
) 
;; 配套函数, 提取选集实体名列表. 
(defun xss2lst (ss / i e lst) 
  (setq i -1) 
  (while (setq e (ssname ss (setq i (1+ i)))) 
    (setq lst (cons e lst)) 
  ) 
  (reverse lst) 
)

zhangrunze · 发表于 2024-4-18 14:14:28

1006882982 发表于 2012-6-26 03:27
(defun c:pp()
(setq cm (getvar "cmdecho"))
(setvar "cmdecho" 0)

感谢分享~
单线或多线转多段线~

白色微風1991 · 发表于 2023-6-21 11:16:32

這個功能效率很高，謝謝樓主分享謝謝分享

SYTDD · 发表于 2018-2-9 11:16:45

狂刀无聊出品都这么帮，希望你天天都无聊，呵呵，谢谢分享

461045462 · 发表于 2011-5-11 08:20:52

谢谢楼主的分享
收藏了,下来学习领会
谢谢

display18 · 发表于 2011-5-12 19:35:26

收藏备用，呵呵

kinglzk2000 · 发表于 2011-5-12 19:48:10

no function definition: VLAX-CURVE-GETSTARTPOINT

13579 · 发表于 2011-5-12 19:52:20

收藏备用

e688w · 发表于 2011-6-6 14:00:56

备用！正在收集这方面的资料做水力计算！

killer9806 · 发表于 2011-6-6 16:53:15

谢谢分享。程序利用点的方式获取物体进行组建多义线。

669423907 · 发表于 2011-6-6 18:37:17

狂刀的程序，一定要收藏！

luyu9635 · 发表于 2011-6-6 21:35:17

希望你天天都无聊，呵呵

yhkk0317 · 发表于 2011-6-9 10:48:54

正缺这功能呢

账号		自动登录	找回密码
密码			注册

源码无聊贴:xj(连接首尾相连线条成封闭多义线) --by 狂刀 2007.9

本帖子中包含更多资源

点评