求助点连线的lisp

qiaojingjun

求助大神，怎么点连线 ，见附件

yshf

1. <blockquote>;点排序画线

复制代码

xyp1964

1. (defun c:tt ()
   
2.   (if (setq ss (ssget '((0 . "POINT"))))
   
3.     (setq ptn (mapcar '(lambda (x) (xyp-DXF 10 x)) (xyp-Ss2List ss))
   
4.           ptn (vl-sort ptn '(lambda (x y) (< (car x) (car y))))
   
5.           s1  (xyp-Pline ptn nil)
   
6.     )
   
7.   )
   
8.   (princ)
   
9. )

(defun c:tt ()<br />   (if (setq ss (ssget '((0 . "POINT"))))<br />     (setq ptn (mapcar '(lambda (x) (xyp-DXF 10 x)) (xyp-Ss2List ss))<br />           ptn (vl-sort ptn '(lambda (x y) (< (car x) (car y))))<br />           s1  (xyp-Pline ptn nil)<br />     )<br />   )<br />   (princ)<br /> )

yshf

2. ;点排序画线
   
3. (defun c:test()
   
4.     (setq cmd (getvar "cmdecho"))
   
5.     (setvar "cmdecho" 0)
   
6.     (command "_undo" "be")
   
7.     (if (setq ssa (ssget '((0 . "point"))))
   
8.         (progn
   
9.             (setq pts (mapcar '(lambda(ent)(cdr (assoc 10 (entget ent))))
   
10.                                (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssa)))
    
11.                       )
    
12.             )
    
13.             ;按圆弧方式排序
    
14.             (setq p0 (mapcar '/ (apply 'mapcar (cons '+ pts))
    
15.                                 (list (length pts) (length pts))
    
16.                       )
    
17.             )
    
18.             (setq pts (vl-sort pts '(lambda(a b) (< (angle p0 a) (angle p0 b)))))
    
19.           
    
20.         ;或者按从左至右、由上往下方式排序
    
21.           　;(setq pts (vl-sort pts '(lambda(a b)(if (equal (car a) (car b))
    
22.             ;                                            (> (cadr a) (cadr b))
    
23.             ;                                            (< (car a)  (car b))
    
24.             ;                                        )
    
25.             ;                            )
    
26.             ;              )
    
27.             ; )
    
28.           
    
29.             ;画多段线
    
30.             (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
    
31.                                    (cons 90 (length pts))
    
32.                             )
    
33.                             (mapcar '(lambda(x)(list 10 (car x) (cadr x))) pts)
    
34.                     )
    
35.             )
    
36.         )
    
37.      )
    
38. 
    
39.      (command "_undo" e)
    
40.      (setvar "cmdecho" cmd)
    
41.      (princ)
    
42. )

;点排序画线<br /> (defun c:test()<br />     (setq cmd (getvar "cmdecho"))<br />     (setvar "cmdecho" 0)<br />     (command "_undo" "be")<br />     (if (setq ssa (ssget '((0 . "point"))))<br />         (progn<br />             (setq pts (mapcar '(lambda(ent)(cdr (assoc 10 (entget ent))))<br />                                (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssa)))<br />                       )<br />             )<br />             ;按圆弧方式排序<br />             (setq p0 (mapcar '/ (apply 'mapcar (cons '+ pts))<br />                                 (list (length pts) (length pts))<br />                       )<br />             )<br />             (setq pts (vl-sort pts '(lambda(a b) (< (angle p0 a) (angle p0 b)))))<br />           <br />         ;或者按从左至右、由上往下方式排序<br />           　;(setq pts (vl-sort pts '(lambda(a b)(if (equal (car a) (car b))<br />             ;                                            (> (cadr a) (cadr b))<br />             ;                                            (< (car a)  (car b))<br />             ;                                        )<br />             ;                            )<br />             ;              )<br />             ; )<br />           <br />             ;画多段线<br />             (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")<br />                                    (cons 90 (length pts))<br />                             )<br />                             (mapcar '(lambda(x)(list 10 (car x) (cadr x))) pts)<br />                     )<br />             )<br />         )<br />      )<br /> <br />      (command "_undo" e)<br />      (setvar "cmdecho" cmd)<br />      (princ)<br /> )

13648893846

坐标排序，然后再连

13648893846

你的上一个帖子中，我给你写好的随便改一下就好了

qiaojingjun

13648893846 发表于 2019-2-12 17:54
坐标排序，然后再连

咋操作  门外汉一枚

13648893846

(defun c:tt1(/ ss entlst)
   (setq ss (ssget '((0 . "POINT"))))
   (setq entlst(gxl-Sel-SS->List ss))
   (setq entlst (vl-sort entlst '(lambda (p1 p2)(< (car (cdr (assoc 10 (entget p1))))
                          (car (cdr (assoc 10 (entget p2))))))))
   (LC:Make-LWPOLYLINE1(mapcar'(lambda(x)(dxf 10 (entget x)))entlst))
);仅对测试图有效，其他得看你的约束条件

13648893846

xyp1964 发表于 2019-2-12 23:01

院长的代码好精辟

qiaojingjun

13648893846 发表于 2019-2-13 08:51
院长的代码好精辟

选择对象:  ; 错误: no function definition: XYP-SS2LIST  大神 这个是咋回事  好像不灵

edsion24

no function definition: GXL-SEL-SS->LIST