qiaojingjun 发表于 2019-2-12 10:44:38

求助点连线的lisp

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

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

本帖最后由 yshf 于 2019-2-14 10:39 编辑

<blockquote>;点排序画线

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

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

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

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

   (command "_undo" e)
   (setvar "cmdecho" cmd)
   (princ)
)

13648893846 发表于 2019-2-12 17:54:21

坐标排序，然后再连

13648893846 发表于 2019-2-12 17:56:29

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

qiaojingjun 发表于 2019-2-12 17:58:45

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

咋操作门外汉一枚:lol

13648893846 发表于 2019-2-12 18:06:04

本帖最后由 13648893846 于 2019-2-12 18:09 编辑

(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 发表于 2019-2-13 08:51:01

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


院长的代码好精辟

qiaojingjun 发表于 2019-2-13 19:05:09

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

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

edsion24 发表于 2019-2-14 08:41:50

no function definition: GXL-SEL-SS->LIST
页: [1] 2
查看完整版本: 求助点连线的lisp