求大神发个这种LISP程序

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

求大神发个这种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程序

本帖子中包含更多资源

本帖子中包含更多资源