救命啊！如何画跨线？？？？？

masterlam 发表于 2002-6-14 10:46:00

请问画线过程中，要实现一条直线遇到另一条直线时要断线跨过去，是怎么操作的呢？？我每次都是让两直线相交之后，再用“打断”命令，这个操作很繁很笨，有什么小技巧吗？还是要先定义线型呢？

mccad 发表于 2002-6-14 11:56:00

要编个小程序，你把问题写详细点吧

masterlam 发表于 2002-6-14 13:40:00

具体情况是-----

│
a ─────────
b│
c ─────────
│
我的遇到问题是：我想画图中的b线，b线遇到a、c线就自动断开跨过去。本人的知识有限，每次画这些线时我都是画交线b然后再把它们的交点断开，还有其它什么方法可以搞定吗？？？？？？？？？

nbzsj 发表于 2002-6-14 14:46:00

如果你的a、c线间距相等，用阵列简单

mccad 发表于 2002-6-14 16:07:00

碰到问题，线被第一根线断开后就成两根了，就要判断形成的两根线跟第三跟线的关系

这样循环下去，运算量还是比较大的。

mccad 发表于 2002-6-14 16:28:00

算了，先写个简单的程序吧，以后有时间再写全面，你加载后按提示试试看

(defun c:bl (/ cont selfl entfl fl fl1 fl2 nl nl1 nl2 xl)
(setvar "cmdecho" 0)
(setq cont 0)
(while (= cont 0)
(setq
   selfl (I:EntSelF "\n选择要断开的直线<回车退出>:" '((0 . "Line")))
)
(if selfl
   (progn
(setq fl (entget (setq entfl(car selfl))))
(redraw entfl 3)
(setq fl1 (cdr (assoc 10 fl))
      fl2 (cdr (assoc 11 fl))
)
(setq nl (I:EntSelF "\n选择用于断开的界线<回车退出>:"
   '((0 . "Line"))
)
)
(if nl
   (progn
   (setq nl (entget (car nl)))
   (setq nl1 (cdr (assoc 10 nl))
   nl2 (cdr (assoc 11 nl))
   )
   (if (setq xl (inters fl1 fl2 nl1 nl2))
      (progn
         (command "_break" selfl "f" xl "@")
(princ "\n直线已经被断开成两段。")
)
      (princ "\n两线不相交，无法断开，请重新操作。")
   )
   )

   (progn
   (setq cont 1)
   (princ "\n程序退出。")
   )
)
   )
   (progn
(setq cont 1)
(princ "\n程序退出。")
   )
)
)
(setvar "cmdecho" 1)
(princ)
)

(defun I:EntSelF (Msg Filter / EntN pbDist PtPick ssPick)
(while (not EntN)
(setq
   EntN (if Msg
      (entsel Msg)

      (entsel)
   )
)
(if (= (getvar "ErrNo") 52)
   (setq EntN "Exit")
)
)
(cond
((/= EntN "Exit")
(setq
   pbDist (abs
(/
   (*
   (/
      (getvar "PickBox")
      (cadr (getvar "ScreenSize"))
   )
   (getvar "ViewSize")
   )
   (sin (* 0.25 pi))
)
      )
   PtPick (cadr EntN)
)
(if (setq ssPick (ssget "_C"
      (polar PtPick (* 1.25 pi) pbDist)
      (polar PtPick (* 0.25 pi) pbDist)
      Filter
      )
)
   (cons
(ssname ssPick 0)
(list PtPick)
   )
)
)
)
)
(princ"\n断线程序已加载，请输入bl执行--明经通道http://www.mjtd.com。")

龙龙仔 发表于 2002-6-14 17:13:00

试试看,临时改的,可能不行….

试试看,临时改的,可能不行….
(defun C:LINES (/ SS1 SS2 SS3 SSL PTS AOBJ1 AOBJ2 N1 N2 IPTS A N NN
HOLDOSMODE
      )
(vl-load-com)
(command "_.UNDO" "_GROUP")
(setq HOLDOSMODE (getvar "OSMODE"))
(setvar "OSMODE" 0)
(prompt "\n选择要断开的线:")
(setq SS1 (ssget '((0 . "*LINE,ARC"))))
(prompt "\n选择用于断开的界线:")
(setq SS2 (ssget '((0 . "*LINE,ARC"))))
(command "_.SELECT" SS1 SS2 "")
(setq SS (ssget "P"))
(setq N10
SSL (sslength SS)
)
(while (< N1 (1- SSL))
(setq AOBJ1 (ssname SS N1)
   AOBJ1 (vlax-ename->vla-object AOBJ1)
   N2 (1+ N1)
)
(while (< N2 SSL)
   (setq AOBJ2 (ssname SS N2)
   AOBJ2 (vlax-ename->vla-object AOBJ2)
   IPTS(vla-intersectwith
   AOBJ1
   AOBJ2
   0
   )
   IPTS(vlax-variant-value IPTS)
   )
   (if (> (vlax-safearray-get-u-bound IPTS 1) 0)
(progn
   (setq IPTS
(vlax-safearray->list IPTS)
   )
   (while (> (length IPTS) 0)
   (setq PTS(cons (list (car IPTS)
   (cadr IPTS)
   (caddr IPTS)
      )
      PTS
      )
   IPTS (cdddr IPTS)
   )
   )
)
   )
   (setq N2 (1+ N2))
)
(setq N1 (1+ N1))
)
(setq N 0)
(repeat (length PTS)
(setq A (ssget "C" (nth N PTS) (nth N PTS)))
(setq SS3 (ssadd))
(setq N1 0)
(repeat (sslength A)
   (if (not (ssmemb (ssname A N1) SS2))
(ssadd (ssname A N1) SS3)
   )
   (setq N1 (1+ N1))
)
(setq A SS3)
(setq NN 0)
(repeat (sslength A)
   (command "_.BREAK" (ssname A NN) (nth N PTS) (nth N PTS))
   (setq NN (1+ NN))
)
(setq N (1+ N))
)
(setvar "OSMODE" HOLDOSMODE)
(command "_.UNDO" "_END")
(princ)
)

masterlam 发表于 2002-6-14 18:20:00

谢谢各位！

谢谢各位，其实我对程序还不是很熟，我会试试看。
本人学的是制冷，制冷流程特别的重要，画图时管线的连接特别的烦琐，如果还有什么更好的方法请告诉我，谢谢

masterlam 发表于 2002-6-14 20:36:00

在哪里编辑、加载这个程序的？？嘻嘻------菜鸟

mccad 发表于 2002-6-14 22:22:00

把程序拷贝并保存为名为bline.lsp文件

然后把文件保存到AutoCAD的/Support目录下。
启动ACAD后按工具菜单->加载应用程序->启动组->内容->添加->选择刚保存的bline.lsp文件，然后确定退出。
以后你就可以输入bl来运行这个程序了。

页: [1] 2

明经CAD社区's Archiver