明经CAD社区

 找回密码
 注册

扫一扫,访问微社区

QQ登录

只需一步,快速开始

查看: 1870|回复: 9

高手请进!

[复制链接]
发表于 2012-8-5 17:22 | 显示全部楼层 |阅读模式
1明经币
本帖最后由 aaacjh 于 2012-8-9 21:16 编辑

只针对共线直线,不论直线多少,不论直线是否相连或相叠或断开,均可实现头尾相连成单一直线。
有难度,自己搞不定!求高手lsp!

调试附件,双手奉上!
附件: 您需要 登录 才可以下载或查看,没有帐号?注册

最佳答案

查看完整内容

我这里有一个 duotu007 大师的 ;框选共线直线并批量连接(duotu007) (defun c:j(/ ss flag n1 n2 ln1 pn1 p1 p2 la ln2 pn2 p3 p4 pp px1 px2 lk la) ;返回共线四点最远2点 (defun maxlong (p1 p2 p3 p4) (setq ptlst '(p1 p2 p3 p4)) (setq n '())(setq i -1) (while (setq a (nth (setq i (1+ i)) ptlst)) ;返回表的第N个元素 (setq b (cdr (member a ptlst))) ;返回a后面的剩余元素,包括a,并去掉a的表 ...
发表于 2012-8-5 17:22 | 显示全部楼层
我这里有一个 duotu007 大师的

;框选共线直线并批量连接(duotu007)
(defun c:j(/ ss flag n1 n2 ln1 pn1 p1 p2 la ln2 pn2 p3 p4 pp px1 px2 lk la)
;返回共线四点最远2点
(defun maxlong (p1 p2 p3 p4)
(setq ptlst '(p1 p2 p3 p4))
(setq n '())(setq i -1)
(while (setq a (nth (setq i (1+ i)) ptlst)) ;返回表的第N个元素
(setq b (cdr (member a ptlst)))                    ;返回a后面的剩余元素,包括a,并去掉a的表
(setq n (append (mapcar '(lambda (x) (list a x)) b) n)))
(setq a1 (mapcar '(lambda (x)
(list(distance (vl-symbol-value (car x))
(vl-symbol-value (cadr x)))x))(reverse n)))
(setq a2 (vl-sort a1 '(lambda (x y) (> (car x) (car y)))))
(setq a3 (car a2))(setq a4 (cadr a3)))
;检测3点是否共线
(defun pppl (pp1 pp2 pp3)
(setq dis1 (distance pp1 pp2))
(setq dis2 (distance pp2 pp3))
(setq dis3 (distance pp1 pp3))
(if (or (<= (abs (- dis1 (+ dis2 dis3))) 0.000001)
(<= (abs(- dis2 (+ dis1 dis3))) 0.000001)
(<= (abs(- dis3 (+ dis2 dis1))) 0.000001)) 1 nil))

(command "._UNDO" "_BEGIN")
(setq ss (ssget '((0 . "LINE"))))
;(setq sn (sslength ss))
(setq flag 0)                                ;选择集变动标志
(setq n1 0)
(while (< n1 (sslength ss))                ;读取选择集图元数量
(setq n2 (+ n1 1))
(while (< n2 (sslength ss))
(setq ln1 (ssname ss n1))                ;把选择集第一个图元名赋给变量ln
(setq pn1 (entget ln1))                        ;获取图原名的定义数据
(setq p1 (cdr (assoc 10 pn1)))                ;直线起点
(setq p2 (cdr (assoc 11 pn1)))                ;直线终点
(setq la (assoc 8 pn1))                 ;直线所在图层
(setq ln2 (ssname ss n2))
(setq pn2 (entget ln2))
(setq p3 (cdr (assoc 10 pn2)))                ;直线起点
(setq p4 (cdr (assoc 11 pn2)))                ;直线终点
(if (and (pppl p1 p2 p3) (pppl p1 p2 p4))
;判断4点共线
(progn(setq pp (maxlong p1 p2 p3 p4)) ;返回共线4点中距离最远的2点
(setq px1 (vl-symbol-value (car pp)) ;第1点
px2 (vl-symbol-value (cadr pp))) ;第2点
(setq lk (entmakex(list '(0 . "LINE") (cons 10 px1) la (cons 11 px2))));生成1到2的直线
(entdel ln1)                                ;删除共线直线lm
(entdel ln2)                                ;删除共线直线ln
(ssdel ln1 ss)                                ;删除选择集中共线图元lm
(ssdel ln2 ss)                                ;删除选择集中共线图元ln
(ssadd lk ss)                                ;增加新生成直线到选择集末尾
(setq flag 1)))
(if (= flag 1)(progn(setq n2 (+ n1 1))
(setq flag 0))
(setq n2 (+ n2 1))))
(setq n1 (+ n1 1)))
(command "._UNDO" "_END")
(princ))
回复

使用道具 举报

发表于 2012-8-5 22:43 | 显示全部楼层
若局限在 水平垂直 线 代码单纯多多
回复

使用道具 举报

 楼主| 发表于 2012-8-7 19:41 | 显示全部楼层
Andyhon 发表于 2012-8-5 22:43
若局限在 水平垂直 线 代码单纯多多

确实如此!
回复

使用道具 举报

发表于 2012-8-7 20:08 | 显示全部楼层
能有样本文件(*.Dwg)可供调试吗?
回复

使用道具 举报

 楼主| 发表于 2012-8-9 21:17 | 显示全部楼层
Andyhon 发表于 2012-8-7 20:08
能有样本文件(*.Dwg)可供调试吗?

附件已传上,有劳了!
回复

使用道具 举报

 楼主| 发表于 2012-8-11 12:57 | 显示全部楼层
669423907 发表于 2012-8-11 11:56
我这里有一个 duotu007 大师的

;框选共线直线并批量连接(duotu007)

大师就是大师,运行的爽啊,有劳您了,感谢!
回复

使用道具 举报

 楼主| 发表于 2012-8-11 13:01 | 显示全部楼层
这也正应验了一句话,三人行,必有我师焉!哈哈!
回复

使用道具 举报

发表于 2012-8-27 17:17 | 显示全部楼层
高手!!!!!!!!!!!!!!!!!
回复

使用道具 举报

发表于 2013-6-29 08:31 | 显示全部楼层
谢谢2楼楼主的分享!很有用啊。
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2019-11-21 01:28 , Processed in 0.207598 second(s), 31 queries , Gzip On.

Powered by Discuz! X3.3

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表