- 积分
- 4847
- 明经币
- 个
- 注册时间
- 2023-4-5
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2025-2-13 20:42:06
|
显示全部楼层
::直线问题可以完美解决,圆弧问题请教各路高手,我只求3个明经币的悬赏。
;;框选共线直线并批量连接:mmjj
;;感谢明经CAD社区!感谢ucuc2003!http://bbs.mjtd.com/forum.php?mo ... C%BD%D3%B6%CF%CF%DF
;;返回共线四点最近2点
(defun minlong (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))
)
;返回共线四点最远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
)
)
;框选共线直线并批量连接
(defun C:mmjj (/ ss flag n1 n2 ln1 pn1 p1 p2 la ln2 pn2 p3 p4 pp px1 px2 lk la)
(command "._UNDO" "_BEGIN")
(princ "\n框选共线直线并批量连接,请选择对象:")
(setq ss (ssget '((0 . "LINE"))))
(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))) ;直线终点
;判断4点共线
(if (and (pppl p1 p2 p3) (pppl p1 p2 p4))
(progn
(setq qq (minlong p1 p2 p3 p4)) ;返回共线4点中距离最近的2点
(setq py1 (vl-symbol-value (car qq)) ;第1点
py2 (vl-symbol-value (cadr qq)) ;第2点
dis4 (distance py1 py2)
)
(setq pp (maxlong p1 p2 p3 p4)) ;返回共线4点中距离最远的2点
(setq px1 (vl-symbol-value (car pp)) ;第1点
px2 (vl-symbol-value (cadr pp)) ;第2点
)
(if (and (<= dis4 4.1)
(> dis4 3.1))
(progn
(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)
) |
评分
-
查看全部评分
|