社区 › AutoLISP/Visual LISP 编程技术 › 求大神发个这种LISP程序

qiaojingjun 发表于 2019-2-3 10:38:22

求大神发个这种LISP程序

求大神发个这种LISP程序点连线

13648893846 发表于 2019-2-11 13:45:05

本帖最后由 13648893846 于 2019-2-11 14:17 编辑

(defun c:tt(/ ss entlst)
(setq ss (ssget '((0 . "TEXT") (1 . "*#*"))))
(setq entlst(gxl-Sel-SS->List ss))
(setq entlst (vl-sort entlst '(lambda (p1 p2)(< (atof (cdr (assoc 1 (entget p1))))
                         (atof (cdr (assoc 1 (entget p2))))))))
(LC:Make-LWPOLYLINE1(mapcar'(lambda(x)(dxf 10 (entget x)))entlst))
)
(defun LC:Make-LWPOLYLINE1 (lst / PT)
(entmake (append (list '(0 . "LWPOLYLINE")
    '(100 . "AcDbEntity")
    '(100 . "AcDbPolyline")
    '(62 . 1)
    (cons 90 (length lst))
   )
   (mapcar '(lambda (pt) (cons 10 pt)) lst)
    )
)
)
(defun gxl-Sel-SS->List (ss / i s )
(if ss
(repeat (setq i (sslength ss))
(setq s (cons (ssname ss (setq i (1- i))) s))
    )
    )
)
(defun DXF (code elist) (cdr (assoc code elist)))

panliang9 发表于 2019-2-13 17:29:58

收藏了，谢谢！

hnzkhyyl 发表于 2019-2-14 08:17:22

二楼是大神

xyp1964 发表于 2019-2-14 13:33:39

;; tt(高程连线)
(defun c:tt (/ ss lst s1)
(if (setq ss (ssget '((0 . "insert") (66 . 1))))
    (setq lst (mapcar '(lambda (x)(list (atoi (last (car (xyp-Att2list x))))(xyp-DXF 10 x))) (xyp-Ss2List ss))
          lst (vl-sort lst '(lambda (x y) (< (car x) (car y))))
          s1(xyp-Pline (mapcar 'cadr lst) t)
    )
)
(princ)
)

jiaxin_1111 发表于 2021-2-18 15:27:03

厉害了！！感谢！！！

paulpipi 发表于 2021-2-20 12:16:30

nijiea123 发表于 2021-2-28 12:18:05

要是能解决编号的问题就更好了

香远益清 发表于 2021-3-2 12:17:44

xyp1964 发表于 2019-2-14 13:33


no function definition: XYP-SS2LIST

查看完整版本: 求大神发个这种LISP程序