框选直线，在框内端点连接成样条曲线

fangmin723

1. ;;说明:框选直线，在框内端点连接成样条曲线
   
2. (defun C:ES(/ dxf10 dxf11 edata ent isptinrectang n pt1 pt2 ptlst ss)
   
3.   ;;;判断p点是否在P1，P2构成的矩形框内
   
4.   ;;;(IsPtInRectang (getpoint) (getpoint) (getpoint))
   
5.   (defun IsPtInRectang(p1 p2 p) (vl-every '>= (mapcar '* (mapcar '- p p1) (mapcar '- p2 p)) '(0 0)))
   
6.   (if (and (setq pt1 (getpoint "\n指定第一个角点："))(setq pt2 (getcorner pt1 "指定第二个角点，确保连接的点在框内：")) (setq ss (ssget "C" pt1 pt2 '((0 . "LINE")))))
   
7.     (progn
   
8.       (setq ptlst nil n -1)
   
9.       (while (setq ent (ssname ss (setq n (1+ n))))
   
10.         (setq edata (entget ent) dxf10 (cdr (assoc 10 edata)) dxf11 (cdr (assoc 11 edata)))
    
11.         (if (IsPtInRectang pt1 pt2 dxf10) (setq ptlst (cons dxf10 ptlst)))
    
12.         (if (IsPtInRectang pt1 pt2 dxf11) (setq ptlst (cons dxf11 ptlst)))
    
13.       )
    
14.       (setq ptlst (vl-sort ptlst (function (lambda(p1 p2) (< (car p1) (car p2))))))
    
15.       (entmake (append (list '(0 . "SPLINE")
    
16.                          '(100 . "AcDbEntity")
    
17.                          '(100 . "AcDbSpline")
    
18.                          '(71 . 3)
    
19.                        )
    
20.                  (mapcar '(lambda (pt) (cons 11 pt)) ptlst)
    
21.                )
    
22.       )
    
23.     )
    
24.   )
    
25.   (prin1)
    
26. )
    

;;说明:框选直线，在框内端点连接成样条曲线<br /> (defun C:ES(/ dxf10 dxf11 edata ent isptinrectang n pt1 pt2 ptlst ss)<br />   ;;;判断p点是否在P1，P2构成的矩形框内<br />   ;;;(IsPtInRectang (getpoint) (getpoint) (getpoint))<br />   (defun IsPtInRectang(p1 p2 p) (vl-every '>= (mapcar '* (mapcar '- p p1) (mapcar '- p2 p)) '(0 0)))<br />   (if (and (setq pt1 (getpoint "\n指定第一个角点："))(setq pt2 (getcorner pt1 "指定第二个角点，确保连接的点在框内：")) (setq ss (ssget "C" pt1 pt2 '((0 . "LINE")))))<br />     (progn<br />       (setq ptlst nil n -1)<br />       (while (setq ent (ssname ss (setq n (1+ n))))<br />         (setq edata (entget ent) dxf10 (cdr (assoc 10 edata)) dxf11 (cdr (assoc 11 edata)))<br />         (if (IsPtInRectang pt1 pt2 dxf10) (setq ptlst (cons dxf10 ptlst))) <br />         (if (IsPtInRectang pt1 pt2 dxf11) (setq ptlst (cons dxf11 ptlst)))<br />       )<br />       (setq ptlst (vl-sort ptlst (function (lambda(p1 p2) (< (car p1) (car p2))))))<br />       (entmake (append (list '(0 . "SPLINE")<br />                          '(100 . "AcDbEntity")<br />                          '(100 . "AcDbSpline")<br />                          '(71 . 3)<br />                        )<br />                  (mapcar '(lambda (pt) (cons 11 pt)) ptlst)<br />                )<br />       )<br />     )<br />   )<br />   (prin1)<br /> )<br />

qazxswk

zixuan203344 发表于 2022-4-15 08:16
建议：下端按最近点排序吧，你按X从小到大排序，不具备通用性

楼主的代码，只是给了一个思路吧。按你的意思，也不具备通用性，比如，当直线都是水平时，连线就混乱了。

fangmin723

zixuan203344 发表于 2022-4-15 08:16
建议：下端按最近点排序吧，你按X从小到大排序，不具备通用性

我也想过，不过最近比较懒，具备最基本的使用就可以了，其他的懒得写！

fangmin723

广易精通 发表于 2023-2-12 12:34
楼主你好！我想生成多段线可以吗？组码怎么对不上，麻烦赐教

可以啊，多段线顶点组码是10

liunian0524

感谢分享，源码都得支持

zixuan203344

建议：下端按最近点排序吧，你按X从小到大排序，不具备通用性

999999

谢谢大神的分享，

hhh454

感谢楼主分享，学习

nijiea123

很不错呀 感谢分享

zghmaya

很不错呀 感谢分享

广易精通

楼主你好！我想生成多段线可以吗？组码怎么对不上，麻烦赐教