[原创]：批量生成复合线边界的LISP程序

Gu_xl · 发表于 2010-2-2 18:57:11

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

[C] 纯文本查看 复制代码

;;; La为图层名(defun Layer_zdsb (La / sel make_point_list n mn en entype pt1 pt2 pL sel k
		      p1 p2 enlast ensel
		  )		       ; ===============================
				       ; 表操作函数
				       ; 判断点 p1 是否在点集PL中，是返回T
				       ; ，不是返回nil，a为精度
				       ; 例 (IsInPointList '(1.0001 1.001 0)
				       ; '((1 1 0) (2 1 0)) 0.001),返回T
  (defun IsInPointList (p1 PL a)       ; (setq n (length PL))
    (if (member t (mapcar
		    '(lambda (b)
		       (equal p1 b a)
		     )
		    PL
		  )
	)
      t
      nil
    )
  )				       ; 取出图元索引i对应的值
  (defun dxf (ent i)
    (cdr (assoc i (entget ent)))
  )				       ; 取圆弧的起点、终点。中点
  (defun arc_3point (a / cenp radius STP ENPmp arcmidpoint)
    (setq cenp (cdr (assoc 10 (entget a))))
    (setq radius (cdr (assoc 40 (entget a))))
    (setq STP (vlax-curve-getPointAtParam A
					  (vlax-curve-getstartparam A)
	      )
    )
    (setq ENP (vlax-curve-getPointAtParam A (vlax-curve-getEndParam A)))
    (setq arcmidpoint (polar (polar stp (angle stp enp) (/
							   (distance STP ENP)
							   2.0
							)
			     ) (angle cenp (polar stp (angle stp enp)
						  (/ (distance STP ENP) 2.0)
					   )
			       ) (- radius (distance (polar stp
							    (angle stp enp)
							    (/
							       (distance STP ENP)
							       2.0
							    )
						     ) cenp
					   )
				 )
		      )
    )
    (list stp enp arcmidpoint)
  )


  ;; 根据选择集中的line、arc、circle，生成点集
  (defun make_point_list (s / PL)
    (setq n 0
	  PL '()
	  mn (sslength s)
    )
    (repeat mn
      (setq en (ssname s n)
	    enType (dxf en 0)
      )
      (cond
	((= enType "LINE")
	  (setq pt1 (dxf en 10)
		pt2 (dxf en 11)
	  )
	  (if (not (IsInPointList pt1 pl 0.00001))
	    (setq pl (cons pt1 pl))
	  )			       ; if
	  (if (not (IsInPointList pt2 pl 0.00001))
	    (setq pl (cons pt2 pl))
	  )			       ; if
	)
	((= enType "ARC")
	  (setq pt1 (car (arc_3point en))
		pt2 (cadr (arc_3point en))
	  )
	  (if (not (IsInPointList pt1 pl 0.00001))
	    (setq pl (cons pt1 pl))
	  )			       ; if
	  (if (not (IsInPointList pt2 pl 0.00001))
	    (setq pl (cons pt2 pl))
	  )			       ; if

	)

      )				       ; cond
      (setq n (1+ n))
    )				       ; repeat
    (setq pl pl)
  )				       ; make_point_list
				       ; 此处SEL选择集可自行修改为命令行选择
				       ; 代码
  (setq sel (ssget "x" (list '(0 . "line,arc,circle") (cons 8 La))))
  (if sel
    (progn
      (setq Plist (make_point_list sel))
      (setq enlast (entlast)
	    ensel (ssadd)
      )
      (setvar "CLAYER" la)
      (command "_.boundary" "a" "b" "n" sel "" "")
      (setq n -1
	    mn 0
	    k (length Plist)
      )
      (repeat k
	(setq p0 (nth (setq n (1+ n))
		      Plist
		 )
	      mn n
	)
	(repeat (- k n 1)
	  (setq p1 (nth (setq mn (1+ mn))
			Plist
		   )
	  )
	  (setq p2 (midpoint p0 p1))
	  (command p2)
	)			       ; repeat
      )				       ; repeat
      (command "")
      (while (setq en (entnext enlast))
	(setq enlast en)
	(ssadd en ensel)
      )				       ; while
      (command "erase" sel "")
      (setq ensel ensel)
    )				       ; progn
    nil
  )				       ; if
)

同心 · 发表于 2010-2-11 14:55:18

执行的命令是多少？

xyp1964 · 发表于 2010-2-11 16:20:47

类似——暗柱边线

同心 · 发表于 2010-2-11 17:30:14

xyp1964斑竹，你的程序非常好

xtl9720209 · 发表于 2010-3-9 11:32:46

好东东，怎么导入CAD呢？

Gu_xl · 发表于 2010-3-18 19:39:14

为了提高生成Boundary边界的效率，可对选择集的直线、园作一下打断处理，具体打断方法本论坛有很多讨论。可参见下帖：
http://www.xdcad.net/forum/showt ... splay=&pagenumber=2
；然后将下述述代码做如下改动：
;;;=========================================================
;;;此处SEL选择集可自行修改为命令行选择代码
(setq sel (ssget "x" (list '(0 . "line,arc,circle") (cons 8 La))))
(if sel
(progn
(setq Plist (make_point_list sel))
(setq enlast (entlast) ensel (ssadd))
(setvar "CLAYER" la)
(command "_.boundary" "a" "b" "n" sel "" "" )
(setq n -1
mn 0
k (length Plist))
(repeat k
(setq p0 (nth (setq n (1+ n)) Plist) mn n)
(repeat (- k n 1)
(setq p1 (nth (setq mn (1+ mn)) Plist))
(setq p2 (midpoint p0 p1))
(command p2)
);repeat
);repeat
(command "")
;;;========================================================
[QUOTE]
代码改动如下：
;;;=======================================================
;;;插入打断代码
(princ (strcat "\n正在整理 " La " 数据..........."))
  ;此处自行添加打断代码
  (setq sel (ssget "x" (list '(0 . "line,arc,circle") (cons 8 La))))

(if sel
  (progn

(setq Plist (make_point_list sel))
(zoom_window (setq recList (get_rec_pointlist Plist)))
;;;计算点范围Y值的五百分之一
(setq VerticalLimit (* 0.002 (- (cadadr recList) (cadar recList))))
(if (< VerticalLimit 0.2) (setq VerticalLimit 0.2))

  (setq enlast (entlast) ensel (ssadd))
;;;如果enlast为块定义，得到最后子图元
(while (entnext enlast)
   (setq enlast (entnext enlast))
)
(setq enlast1 enlast)
  (setvar "CLAYER" la)

  (command "_.boundary"  "a" "i" "n" "+x" "b" "n" sel "" "" )
(setq ki -1
      k (sslength Sel))
(princ "\n共有 ")
(princ K)
(princ " 边，正在生成边界.........")
(princ K)
  (repeat k
(setq en-line (ssname Sel (setq ki (1+ ki)))
      LpLst (LAC-LR-Point en-line VerticalLimit);直线两边点
      )
(command (car LpLst))
(command (cdr LpLst))

);repeat
  (command "")

;;;======================================================
这样生成边界的速度可比原程序快十倍，选择物体越多，速度差距越明显！

kinglzk2000 · 发表于 2010-3-20 20:48:32

命令是什么呢没看出用什么唤起啊

Gu_xl · 发表于 2010-3-23 22:48:37

我把完整的程序源码传上来，请大家使用，源码见附件！加载boundary.lsp后，command命令下敲入 bianjie即可运行！

rq28 · 发表于 2013-4-2 10:29:15

没看到附件啊
强烈支持，G版主就是牛啊

仲文玉 · 发表于 2013-4-2 10:35:11

:lol顶下G版的帖子，算法高明

eggplant8008 · 发表于 2013-4-2 15:35:55

Gu_xl:lol在这也有啊

wowan1314 · 发表于 2013-4-6 16:10:50

支持！！！:lol:lol:lol

kwok · 发表于 2013-4-12 14:09:01

我也来支持;P;P

GTJ116600 · 发表于 2013-4-18 17:23:11

好贴！G版主厉害！！！

GTJ116600 · 发表于 2013-4-18 17:27:48

期待G版主的完整代码

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

[原创]：批量生成复合线边界的LISP程序

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

本帖被以下淘专辑推荐:

相关帖子