提取多线段所在的图层名并按顶点顺序提取顶点处文字到文本

1681008

提取多线段所在的图层名，并按多线段顶点顺序提取顶点处文字到文本



有劳论坛大神百忙中抽空弄个lsp用用！谢谢！谢谢！

yshf

;请试用以下程序
(defun c:tqddxwz()
     (setq path (getvar "dwgprefix"))
     (if (setq ssddx (ssget '((0 . "LWPOLYLINE"))))
         (if (setq wjm (getfiled "请指定存盘文件" path "txt" 1))
             (progn
                 (setq wjsjb nil)
                 (if (setq sswz (ssget "x" '((0 . "text"))))
                     (setq wjsjb (mapcar '(lambda(ent)
                                               (setq dxf (entget ent))
                                               (setq pt  (cdr (assoc 11 dxf)))
                                               (if (equal pt '(0 0 0)) (setq pt (cdr (assoc 10 dxf))))
                                               (list (cdr (assoc 1 dxf)) pt (cdr (assoc 40 dxf)))
                                          )
                                          (vl-remove-if 'listp (mapcar 'cadr (ssnamex sswz)))
                                  )
                    )
                 )
                 (setq ddxent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssddx))))                              
                 (setq fff (open wjm "w"))
                 (foreach ent ddxent
                     (setq dxf (entget ent)
                           tcm (cdr (assoc 8 dxf))
                     )
                     (setq pts (mapcar 'cdr (vl-remove-if '(lambda(x)(/= (car x) 10)) dxf)))
                     (foreach pt pts
                          (setq ptb nil)
                          (if wjsjb
                              (setq ptb (vl-remove-if '(lambda(zb)
                                                           (> (distance pt (cadr zb)) (* 1.25 (last zb)))
                                                       )
                                                       wjsjb
                                        )
                              )
                          )
                          (If ptb
                              (progn
                                  (setq ptb (vl-sort ptb '(lambda(a b)(< (distance pt (cadr a)) (distance pt (cadr b))))))
                                  (princ (strcat tcm  " , " (caar ptb) "\n") fff)
                                  (setq wjsjb (vl-remove (car ptb) wjsjb))
                              )
                          )
                     )
                 )
                 (close fff)
             )
         )
     )
     (princ)
)

1681008

yshf 发表于 2019-5-21 08:23
;请试用以下程序
(defun c:tqddxwz()
     (setq path (getvar "dwgprefix"))

谢谢大神！
现在省事多了，再次表示由衷的感谢、谢谢！！

yfanzi

yshf 发表于 2019-5-19 14:44
;请试用以下程序
(defun c:tqddxwz()
     (setq path (getvar "dwgprefix"))

控制文字距离的语句是哪行啊？输出完后可否亮显？

逍遥无声

顶顶顶顶顶