多段线节点坐标提取

gaomingabc456

(defun c:jdzbtq();;;节点坐标提取
  (vl-load-com)
  (setvar "cmdecho" 0)
  (COMMAND ".UNDO" "BE")
  (setvar "dimzin" 0)
  (princ "\n 选取PLINE多段线...")
  (setq ss (ssget '((0 . "LWPOLYLINE"))))
  (if (/= ss nil)
  (progn
  (setq fn (getfiled "\n 文件保存为" "d:/多段线节点坐标" "txt" 1))
  (setq ff  (open fn "w"))
  ;;(princ "点号,X坐标,Y坐标" ff)
  ;;(princ "\n" ff)  ;换一行输入
  (setq s1(mapcar'(lambda(x)(cons x (plinexy x)))(sstoes ss)) i 0 pp 0)
  (repeat(length s1)
    (setq ss(nth i s1) h(dxf (car ss) 38) nn 0)
    (repeat (length(cdr ss))
      ;;(setq str(strcat(itoa (+ pp 1))","(itoa (+ i 1))","(rtos(cadr(nth nn(cdr ss)))2 4)","(rtos(car(nth nn(cdr ss)))2 4)","(rtos h 2 3)) nn(+ nn 1)  pp(+ pp 1))
      (setq str(strcat(itoa (+ pp 1))","(rtos(car(nth nn(cdr ss)))2 4)","(rtos(cadr(nth nn(cdr ss))) 2 4)) nn(+ nn 1)  pp(+ pp 1))
      (write-line str ff))
    (setq i(+ i 1))
  )
  (close ff)
  (princ "\n  cass数据格式导出完成！")
  (startapp "notepad.exe" fn)
  )
)
  (princ)
)

(defun lst-(l1 l2)(if l2(foreach x l2(setq l1(vl-remove x l1)))l1))
(defun dxf (ent i) (if(= (type ent) 'ename) (setq ent (entget ent)) )  (cdr (assoc i ent)) )
(defun SstoEs(ss / a lst)
  (if ss(progn(setq a -1)(repeat(sslength ss)(setq lst(cons(ssname ss(setq a(1+ a)))lst))))))
(defun plinexy(e / a q m p p1)
    (setq a(vlax-ename->vla-object e)
          q(vlax-safearray->list(vlax-variant-value(vla-get-Coordinates a)))
          m(if(=(vla-get-objectname a)"AcDb3dPolyline")
             '(setq p1(list (car q)(cadr q)(caddr q))q(cdddr q))
             '(setq p1(list (car q)(cadr q))q (cddr q))))
    (while q(eval m) (setq p(if(member p1 p)p(append p(list p1))))))

wanhongron

能在图中增加节点编号功能吗？工作中用的比较多

1751920954

大佬，能改成以米为单位，保留三位小数吗？

jkop

路过，收藏！

gaomingabc456

wanhongron 发表于 2022-4-26 12:56
能在图中增加节点编号功能吗？工作中用的比较多

批量多段线坐标标注  节点编号  导出坐标
http://bbs.mjtd.com/forum.php?mo ... amp;fromuid=7322630
(出处: 明经CAD社区)