多段线节点坐标提取
(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 "\ncass数据格式导出完成!")
(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))))))
能在图中增加节点编号功能吗?工作中用的比较多:handshake 大佬,能改成以米为单位,保留三位小数吗? 路过,收藏! wanhongron 发表于 2022-4-26 12:56
能在图中增加节点编号功能吗?工作中用的比较多
批量多段线坐标标注节点编号导出坐标
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=190406&fromuid=7322630
(出处: 明经CAD社区)
页:
[1]