最近论坛冷清了。哪位大师能搞个点击封闭多段线提取文本

flytoday · 发表于 2012-3-31 09:48:43

就是只要点击多段线。。然后在封闭的多段线内点击就能。。提取到。。封闭的多段线内所有的文本。并输出EXL/。文本名称。个数

最近论坛冷清了不少。。。发个贴哈哈

yjr111 · 发表于 2012-3-31 09:48:44

本帖最后由 yjr111 于 2012-3-31 18:13 编辑

手痒痒，我发一个吧

(defun c:inplwbtj(/ e pt vla_e p1 plst n anglst stretchplst )
;;;;;;;;;;;;;;;;选多段线;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq e(car(setq ent(entsel"\n选择多段线")))
pt(cadr ent)
vla_e(vlax-ename->vla-object e)
)
;;;;;;;对多段线有效;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(cond((= (vla-get-objectname vla_e) "AcDbPolyline")
(setq plst (lst->3p
(vlax-safearray->list(vlax-variant-value(vla-get-coordinates vla_e)))
2
)
)
)
((= (vla-get-objectname vla_e) "AcDb2dPolyline")
(setq plst (lst->3p
(vlax-safearray->list(vlax-variant-value(vla-get-coordinates vla_e)))
3
)
)
)
)
(tjwb)
(princ)
)
(DEFUN TJWB(/ N SS STR_LST LST_STR STR1 SHUL STRLST )
(SETQ SS(SSGET "wp" plst '((0 . "*TEXT"))))
(SETQ N 0)
(WHILE (< N (SSLENGTH SS))
(SETQ LST_STR (APPEND LST_STR (LIST (CDR(ASSOC 1 (ENTGET (SSNAME SS N)))))))
(SETQ N (1+ N))
)
(SETQ LST_STR (vl-sort LST_STR(function(lambda(x y) (< x y)))))
(SETQ STRLSTLEN (LENGTH LST_STR))
(WHILE LST_STR
(SETQ SHUL(- STRLSTLEN(LENGTH(SETQ LST_STR(VL-REMOVE (SETQ STR1 (CAR LST_STR))LST_STR)))))
(SETQ STRLST (APPEND STRLST (LIST(LIST STR1 SHUL))))
(SETQ STRLSTLEN (LENGTH LST_STR))
)
(SETQ STRLST (append (list '("文本名称" "数量（个）"))STRLST ))
(setq ff1 (getfiled "输出到excel" "文本统计" "CSV" 1))
(setq ff2(open ff1 "a"))
(setq i 0)
(repeat (length STRLST)
(SETQ lst_bzmp (nth i STRLST))
(setq txt (vl-string-translate "( )" ",,,"(vl-princ-to-string lst_bzmp)))
(setq txt (vl-string-subst "" "," txt))
(write-line txt ff2)
(setq i (1+ i))
)
(close ff2)
)
;;;;;;函数：将点表num个一组重新组表，用于处理多段线顶点坐标;;;;;;;;;;;;;;;;;
(defun lst->3p (lst num / n lst_new1 lst_newpoint)
(setq n 0)
(mapcar
(function
(lambda (x)
(setq lst_new1 (append lst_new1 (list x)))
(if (= (rem (1+ n) num) 0)
(progn
(setq lst_newpoint (append (list lst_new1) lst_newpoint))
(setq lst_new1 nil)
)
)
(setq n (1+ n))
)
)
lst
)
lst_newpoint
)
(defun fixnum(bl)
(setq bl (/(fix (* bl (expt 10.0 3)))(expt 10.0 3)))
)

(defun c:inplwbtj(/ e pt vla_e p1 plst n anglst stretchplst ) 
  ;;;;;;;;;;;;;;;;选多段线;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
  (setq e(car(setq ent(entsel"\n选择多段线"))) 
        pt(cadr ent) 
        vla_e(vlax-ename->vla-object e) 
        ) 
  ;;;;;;;对多段线有效;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
  (cond((= (vla-get-objectname vla_e) "AcDbPolyline") 
        (setq plst (lst->3p 
               (vlax-safearray->list(vlax-variant-value(vla-get-coordinates vla_e))) 
               2 
               ) 
              ) 
        ) 
       ((= (vla-get-objectname vla_e) "AcDb2dPolyline") 
        (setq plst (lst->3p 
               (vlax-safearray->list(vlax-variant-value(vla-get-coordinates vla_e))) 
               3 
               ) 
              ) 
        ) 
      ) 
  (tjwb) 
  (princ) 
  ) 
  (DEFUN TJWB(/ N SS  STR_LST LST_STR STR1 SHUL STRLST ) 
  (SETQ SS(SSGET "wp" plst '((0 . "*TEXT")))) 
  (SETQ N 0) 
  (WHILE (< N (SSLENGTH SS)) 
    (SETQ LST_STR (APPEND LST_STR (LIST (CDR(ASSOC 1 (ENTGET (SSNAME SS N))))))) 
    (SETQ N (1+ N)) 
   ) 
  (SETQ LST_STR (vl-sort LST_STR(function(lambda(x y) (< x y))))) 
  (SETQ STRLSTLEN (LENGTH LST_STR)) 
  (WHILE LST_STR 
    (SETQ SHUL(-  STRLSTLEN(LENGTH(SETQ LST_STR(VL-REMOVE (SETQ STR1 (CAR LST_STR))LST_STR))))) 
    (SETQ STRLST (APPEND STRLST (LIST(LIST STR1 SHUL)))) 
    (SETQ STRLSTLEN (LENGTH LST_STR)) 
    ) 
(SETQ STRLST (append (list '("文本名称" "数量（个）"))STRLST )) 
(setq ff1 (getfiled "输出到excel" "文本统计" "CSV" 1)) 
(setq ff2(open ff1 "a")) 
(setq i 0) 
(repeat (length STRLST) 
(SETQ lst_bzmp (nth i  STRLST)) 
(setq txt (vl-string-translate "( )" ",,,"(vl-princ-to-string lst_bzmp))) 
(setq txt (vl-string-subst "" "," txt)) 
(write-line txt ff2) 
(setq i (1+ i))       
) 
(close ff2) 
  ) 
;;;;;;函数：将点表num个一组重新组表，用于处理多段线顶点坐标;;;;;;;;;;;;;;;;; 
(defun lst->3p (lst num / n lst_new1 lst_newpoint) 
  (setq n 0) 
  (mapcar 
    (function 
      (lambda (x) 
        (setq lst_new1 (append lst_new1 (list x))) 
        (if (= (rem (1+ n) num) 0) 
          (progn 
            (setq lst_newpoint (append (list lst_new1) lst_newpoint)) 
            (setq lst_new1 nil) 
          ) 
        ) 
        (setq n (1+ n)) 
      ) 
    ) 
    lst 
  ) 
 lst_newpoint 
) 
 
(defun fixnum(bl) 
      (setq bl (/(fix (* bl (expt 10.0 3)))(expt 10.0 3))) 
  )

Andyhon · 发表于 2012-3-31 10:05:59

这儿可能更合宜
数据库/EXCEL/ObjectDBX 编程技术
http://bbs.mjtd.com/forum-27-1.html

建议补上样本文件

flytoday · 发表于 2012-3-31 10:24:14

补上测试文件哈先谢大师啦

Andyhon · 发表于 2012-3-31 11:28:11

...并输出EXL/。文本名称。个数

这些又是如何呈现的呢? (完工的样本文件)

flytoday · 发表于 2012-3-31 11:51:11

本帖最后由 flytoday 于 2012-3-31 12:08 编辑

样式如下

yjr111 · 发表于 2012-3-31 12:19:53

帮你顶一下！

自贡黄明儒 · 发表于 2012-3-31 12:26:34

用ploy ,然后用entlsat获得它，求多段线各顶点，最后(ssget "F" lists)取得其内各图元

flytoday · 发表于 2012-3-31 21:17:26

严哥太给力了。。谢谢。。/。好象严格的EXL输出还缺点什么感觉哈。因为别人的输出以后EXL。在CAD中命令就结算。。生成的EXL文件在未关闭CAD情况下想删就删。但是这个EXL文件删不了。关了CAD以后才能删哦

yjr111 · 发表于 2012-3-31 23:34:01

flytoday 发表于 2012-3-31 21:17
严哥太给力了。。谢谢。。/。好象严格的EXL输出还缺点什么感觉哈。因为别人的输出以后EXL。在CAD中命令就结 ...

生成真正的excel原来有发过，比较烦，这段时间实在太忙了，现在才下班

，有空给你搞一下

账号		自动登录	找回密码
密码			注册

最近论坛冷清了。哪位大师能搞个点击封闭多段线提取文本

最佳答案

相关帖子

点评

评分

评分

本帖子中包含更多资源

本帖子中包含更多资源