求助点连线的lisp

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

qiaojingjun

yshf 发表于 2019-2-14 10:32

非常感谢大神  很好用

gengjun2019

yshf 发表于 2019-2-14 10:40

你这个连起来的是平面多线段，请问能不能改成连接空间点，线是三维线，单线都可以

yshf

将
            ;画多段线
            (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
                                   (cons 90 (length pts))
                            )
                            (mapcar '(lambda(x)(list 10 (car x) (cadr x))) pts)
                    )
            )
改为
            ;画三维多段线
            (entmake  (List '(0 . "POLYLINE") '(100 . "AcDbEntity") '(100 . "AcDb3dPolyline") '(70 . 8)))
            (mapcar '(lambda(pt)(entmake (list '(0 . "vertex") (cons 10 pt) '(70 . 32)))) pts)
            (entmake '((0 . "seqend")))
即可。

gengjun2019

yshf 发表于 2019-6-1 21:23
将
            ;画多段线
            (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntit ...

我替换内容后不能用啊，代码实在看不懂，麻烦您发我个LISP文件，谢谢！！

gengjun2019

gengjun2019 发表于 2019-6-2 11:31
我替换内容后不能用啊，代码实在看不懂，麻烦您发我个LISP文件，谢谢！！

自己试着改好了，非常感谢

yshf

gengjun2019: 文件已传上，请去下载 。

gengjun2019

yshf 发表于 2019-6-2 15:42
gengjun2019: 文件已传上，请去下载 。

非常感谢你的帮忙。经测试点排列顺序有点混乱，很难达到想要的顺序。我想把它改成半自动的连线方式，手动多点几次就行。排列顺序只从左到右排，不受点Z向高度影响。

sunny_8848

挺好用的，要是能画出完整的光滑曲线来就更好了

czf0571

请教一下  命令是啥？