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



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


  3. ;| xj(连接首尾相连线条成封闭多义线) --by 狂刀 2007.9
  4. 说明: 方式:单点一条,自动搜索，多分支提示.
  5. |;
  6. (defun c:xj (/ E ESS FIL OS P1 PA PX0 PX1 ROOP SS SS2 SSS SSS2 X ee)
  7.   (princ "\n 连接首尾相连线条成封闭多义线------by 狂刀 2007.9")
  8.   (command ".undo" "be")
  9.   (setq fil '((0 . "LINE,ARC,*POLYLINE"))
  10. os (getvar "osmode")
  11. pa (getvar "PEDITACCEPT")
  12. ssend(ssadd))
  13.   (setvar "osmode" 0)
  14.   (setvar "PEDITACCEPT" 1)
  15.   ;; 生成首尾相连选集.
  16.   (while (and (princ "\n 选形成多义线的其中一条边线 <退出>:")
  17.        (setq ss (ssget ":S" fil))
  18.   )
  19.     (setq sss (ssadd)
  20.    sss2(ssadd)
  21.    roop nil)
  22.     (setq e (ssname ss 0)
  23.    e0 e
  24.    p0 (vlax-curve-getstartpoint e)
  25.    p1(vlax-curve-getendpoint e))
  26.     (vlax-put (vlax-ename->vla-object e) 'color 1)
  27.     (ssadd e sss)
  28.     (subxj ee p0)
  29.     (subxj ee p1)
  30.     (command ".pedit" "m" sss "" "j" 0.01  "")
  31.     (setq ee (entlast))
  32.     (redraw ee 3)
  33.     ;(vlax-put (vlax-ename->vla-object ee) 'color 3)
  34.     (ssadd ee ssend)
  35.   )
  36.   (mapcar '(lambda(x)(redraw x 4))(xss2lst ssend))
  37.   (setvar "PEDITACCEPT" pa)
  38.   (setvar "osmode" os)
  39.   (command ".undo" "e")
  40.   (princ)
  41. )
  42. ;;
  43. (defun subxj (EE p1 / PX0 PX1 ROOP X esss ess)
  44.   (setq e ee)
  45.   (while (and (setq ss2 (ssget "c" p1 p1 fil))
  46.   (not rooP)
  47.     )
  48.       (setq ess (xss2lst ss2)
  49.      esss(xss2lst sss))
  50.       (mapcar'(lambda(x)(setq ess(vl-remove x ess))) esss)
  51.       (if (not (member e0 ess))
  52. (if (and ess (< 1 (length ess)))
  53.    (progn (mapcar '(lambda (x) (redraw x 3)) ess)
  54.    (setq e (car (entsel "\n 选择分支:")))
  55.    (mapcar '(lambda (x) (redraw x 4)) ess)
  56.    )
  57.    (setq e (car ess))
  58. )
  59.       )
  60.       (if (and e (not (ssmemb e sss)))
  61. (progn
  62.    (ssadd e sss)
  63.    (vlax-put (vlax-ename->vla-object e) 'color 1)
  64.    (setq px0 (vlax-curve-getstartpoint e)
  65.   px1 (vlax-curve-getendpoint e)
  66.    )
  67.    (if (equal p1 px0 1e-4)
  68.      (setq p1 px1)
  69.      (setq p1 px0)
  70.    )
  71. )
  72. (setq roop T)
  73.       )
  74.     )
  75. )
  76. ;; 配套函数, 提取选集实体名列表.
  77. (defun xss2lst (ss / i e lst)
  78.   (setq i -1)
  79.   (while (setq e (ssname ss (setq i (1+ i))))
  80.     (setq lst (cons e lst))
  81.   )
  82.   (reverse lst)
  83. )



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

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

网友答: 這個功能效率很高，謝謝樓主分享    謝謝分享


网友答: 這個功能效率很高，謝謝樓主分享    謝謝分享

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

网友答: 收藏备用，呵呵

网友答: no function definition: VLAX-CURVE-GETSTARTPOINT

网友答: 收藏备用

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

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

网友答: 狂刀的程序，一定要收藏！

网友答: 希望你天天都无聊，呵呵

网友答: 正缺这功能呢
  • 上一篇：批量LSP转FAS
  • 下一篇：没有了
    CAD技术交流中心 | 建筑CAD | 给排水CAD | 暖通CAD | 电气CAD | 电力CAD | 机械CAD | CAD母线槽 | CAD看图
    Copyright © 2019 - 2025