注册 登录
明经CAD社区 返回首页

Gu_xl的个人空间 http://www.mjtd.com/?161460 [收藏] [复制] [分享] [RSS]

日志

画线打断于交点处

热度 8已有 2549 次阅读2012-12-11 18:29 |个人分类:回答问题|系统分类:开发| 画线打断于交点处

画线打断于交点处.lsp

问题来源:http://bbs.mjtd.com/thread-99481-1-1.html

画线打断于交点处.lsp

本源代码由 Gu_xl 编写发布! 联系方式: Email: Gu_xl@sohu.com
;;画线打断于交点处 By Gu_xl 2012.12.11
(defun c:tt (/ LA P0 PT S PL A d)
  (if (null *d*) (setq *d* 0))
  (setq d (getdist (strcat "\n打断距离<" (rtos *d* 2 2) ">:")))
  (if (null d)
    (setq d *d*)
    (setq *d* d)
  )
  (setq d (* 0.5 d))
  (setq la (getvar 'clayer))
  (setq p0 (getpoint "\n第一点:"))
  (while (setq pt (getpoint p0 "\n下一点:"))
    (setq s
	   (ssget "f"
		  (list p0 pt)
		  (list (cons 0 "*line,arc,circle,ellipse") (cons 8 la))
	   )
    )
    (if	s
      (progn
	(setq pl
	       (vl-sort
	       (apply 'append (mapcar '(lambda (x) (mapcar 'cadr (cdddr x))) (ssnamex s)))
	       '(lambda (a b)
		  (< (distance a p0) (distance b p0))
		  )
	       )
	)
	(setq a p0)
	(foreach b pl
	  (if (not (equal p0 b (* 0.1 d)))
	    (progn
	      (entmake
		(list '(0 . "line")
		      (cons 10 a)
		      (cons 11 (polar b (angle pt p0) d))
		)
	      )
	      (setq a (polar b (angle p0 pt) d))
	    )
	  )
	)
	(entmake
	  (list	'(0 . "line")
		(cons 10 a)
		(cons 11 pt)
	  )
	)
      )
      (entmake
	(list '(0 . "line")
	      (cons 10 p0)
	      (cons 11 pt)
	)
      )
    )
    (setq p0 pt)
  )
  (princ)
)

路过

雷人
8

握手

鲜花

鸡蛋

刚表态过的朋友 (8 人)

发表评论 评论 (2 个评论)

回复 longxh28 2013-1-8 15:18
UCS不在原点时好像出错了
回复 yeahyeah 2013-8-21 21:28
老师,你的程序不支持多段线,我改了下,结果遇到很多问题,我正在悬赏,您看下呗。我刚学LISP,实在不行了。。。http://bbs.mjtd.com/thread-107290-1-1.html

facelist doodle 涂鸦板

您需要登录后才可以评论 登录 | 注册

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

GMT+8, 2024-5-5 05:27 , Processed in 0.132218 second(s), 17 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

返回顶部