本帖最后由 xyp1964 于 2019-1-26 17:05 编辑
;; xyp-Ssdel 选择集中删除特定类实体 (xyp-Ssdel sss "1")
;|
实例：
删除特定图层实体：
(setq ss (xyp-Ssdel (ssget) 8 "1"))
(setq ss (xyp-Ssdel (ssget) 8 '("1" "2")))
删除特定实体：
(setq ss (xyp-Ssdel (ssget) 0 "circle"))
(setq ss (xyp-Ssdel (ssget) 0 '("Line" "arc")))
删除特定文本：
(setq ss (xyp-Ssdel (ssget) 1 "test"))
(setq ss (xyp-Ssdel (ssget) 1 '("test" "测试")))
|;
(defun xyp-Ssdel (sss code lst / ss i s1)
(if (= (type sss) 'PICKSET)
(progn
(cond ((= (type lst) 'STR)
(setq ss (ssadd)
i-1
)
(while (setq s1 (ssname sss (setq i (1+ i))))
(if (/= (strcase (cdr (assoc code (entget s1)))) (strcase lst))
(setq ss (ssadd s1 ss))
)
)
)
((= (type lst) 'LIST)
(foreach x lst
(setq ss(xyp-Ssdel sss x)
sss ss
)
)
)
)
ss
)
)
)
本帖最后由 xyp1964 于 2019-1-26 17:05 编辑
;; xyp-R2D 弧度转角度 (xyp-R2D rad)
(defun xyp-R2D (rad) (* (/ rad pi) 180.0))
;; xyp-D2R 角度转弧度 (xyp-D2R ang)
(defun xyp-D2R (ang) (* (/ ang 180.0) pi))
;; xyp-get-tblnext 获得特定符号表的列表 (xyp-get-tblnext "Block")
;; 有效符号表名称为Layer、Ltype、View、Style、Block、Appid、Ucs、Dimstyle 和 Vport
(defun xyp-get-tblnext (table-name / lst d)
(while (setq d (tblnext table-name (null d)))
(setq lst (cons (cdr (assoc 2 d)) lst))
)
(vl-sort lst '<)
)
精品啊！向院长致敬！支持源码!
感谢 xyp1964 版主分享源码程序!
看了院长的，应一个实用演示图加一个LISP源码，我是大陆人，看这些有点费劲
没人点评的了，我来。精精精
很好，很强大，院长就是院长啊，呵呵
本帖最后由 xyp1964 于 2019-1-26 17:06 编辑
;; xyp-Join-Line 直线消重 (xyp-Join-Line ename1 ename2)
(defun xyp-Join-Line (e1 e2 / p1 p2 p3 p4 ptn p10 p11)
(if (and (not (equal e1 e2))
(xyp-Etype e1 "LINE")
(xyp-Etype e2 "LINE")
)
(progn
(setq p1 (xyp-get-dxf 10 e1)
p2 (xyp-get-dxf 11 e1)
p3 (xyp-get-dxf 10 e2)
p4 (xyp-get-dxf 11 e2)
)
(if (and (XYP-3PointAtLine p1 p2 p3)
(XYP-3PointAtLine p1 p2 p4)
)
(progn
(setq ptn (xyp-Sort-ptnByXYZ (list p1 p2 p3 p4))
p10 (car ptn)
p11 (last ptn)
)
(entdel e2)
(xyp-SUBUPD e1 10 p10)
(xyp-SUBUPD e1 11 p11)
t
)
nil
)
)
nil
)
)
;; XYP-3PointAtLine 3点共线 (XYP-3PointAtLine p1 p2 p3)
(defun XYP-3PointAtLine (p1 p2 p3 / dl d1 d2 d3)
(setq dl1e-5
d1(distance p1 p2)
d2(distance p2 p3)
d3(distance p1 p3)
)
(if (or (equal (+ d3 d2) d1 dl)
(equal (+ d1 d2) d3 dl)
(equal (+ d1 d3) d2 dl)
)
t
nil
)
)
;; xyp-Sort-ptnByXYZ 点表按照xyz从小到大排序 (xyp-Sort-ptnByXYZ ptn)
(defun xyp-Sort-ptnByXYZ (ptn / p1 p2)
(vl-sort ptn
'(lambda (p1 p2)
(cond ((< (car p1) (car p2)) T)
((and (= (car p1) (car p2))
(< (cadr p1) (cadr p2))
)
T
)
((and (= (car p1) (car p2))
(= (cadr p1) (cadr p2))
(< (caddr p1) (caddr p2))
)
T
)
(T nil)
)
)
)
)
;; 应用实例
;; gxyh(共线优化)
(defun c:tt ()
(setq ss(ssget '((0 . "line")))
i -1
lst '()
)
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq j i)
(if (not (member s1 lst))
(while (setq s2 (ssname ss (setq j (1+ j))))
(if (not (member s2 lst))
(if (xyp-Join-Line s1 s2)
(setq lst (cons s2 lst))
)
)
)
)
)
(princ)
)
xyp1964 发表于 2012-8-3 21:00 static/image/common/back.gif
太花哨了没实际意用处。
感谢分享1111111