1681008 发表于 2019-5-19 14:44:54

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

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



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

yshf 发表于 2019-5-19 14:44:55

;请试用以下程序
(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 发表于 2019-5-21 09:36:09

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


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

yfanzi 发表于 2019-5-26 08:37:51

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

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

逍遥无声 发表于 2020-8-17 15:37:50

顶顶顶顶顶
页: [1]
查看完整版本: 提取多线段所在的图层名并按顶点顺序提取顶点处文字到文本