【Gu_xl】[原创]根据选择的直线、圆弧选择集构成的封闭区域自动生成LWpolyline

Gu_xl · 发表于 2010-2-2 19:09

本帖最后由 Gu_xl 于 2013-6-11 10:45 编辑

;;;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
)

红色代码有误，已做修改！！！

一张单程票 · 发表于 2021-12-14 13:15

是我不懂吗，好多无用语句，说到底就是这个命令的(command "_.boundary" "a" "b" "n" sel "" )

864643236 · 发表于 2017-11-5 17:04

感谢楼主，很不错的插件，但为什么只能在俯视图里使用呢，要是能实用所有视图就好了

669423907 · 发表于 2011-7-14 20:45

很高！看不懂！

sunsky · 发表于 2011-11-6 00:32

;;;此处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))
在VB中如何实现呢?

santalin · 发表于 2011-12-13 18:52

这个对于圆弧和多段线的处理有问题

mzyshx · 发表于 2013-7-14 00:19

学习了

comechris · 发表于 2013-8-21 20:27

谢谢分享
是直接把代码复制到TXT，然后改成LSP，再用CAD加载吗？

KunG-n · 发表于 2013-9-23 11:18

支持支持支持支持支持支持支持支持支持支持支持支持支持支持支持支持

flyfox1047 · 发表于 2013-11-9 13:05

为什么没有配动图？

bzhjl · 发表于 2014-1-2 11:59

很高！看不懂！谢谢分享

清风明月名字 · 发表于 2014-1-2 14:26

谢谢楼主的分享！很有意思

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

[【Gu_xl】] 【Gu_xl】[原创]根据选择的直线、圆弧选择集构成的封闭区域自动生成LWpolyline

本帖被以下淘专辑推荐:

点评