lifuq1979 发表于 2017-11-8 20:32:06

哪位大神帮看看问题出在哪

想做个批量封闭区域文字输出到TXT的程序，每个封闭区域内有编号,面积(亩),户主姓名等.要求每个封闭区域内的文字输出到txt为一行
单个封闭区域程序没大问题
(defun c:tt(/ en ent ptl ss)
        (vl-load-com)
(setq file1 (getfiled "文件保存在" "d:/" "TXT" 1))
(setq file2 (open file1 "W"))
(if (setq ent (entsel))
    (progn
      (setq en (car ent))
      (setq ptl (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en))))
      (setq ss (ssget "wp" ptl '((0 . "*text"))))
                        (setq n (sslength ss))
      (setq i 0)
                        (setq ss2 " ")
               (while (< i n)
                        (setq ss1 (cdr(assoc 1 (entget(ssname ss i)))))
      (setq ss2(strcat ss1 "," ss2))
                        (setq i (1+ i))
       )
                        (write-line ss2 file2)
    )
)
        (close file2)
(princ)
)

可是改成批量就出错了
(defun c:tt(/ en ent ptl ss)
        (vl-load-com)
(setq file1 (getfiled "文件保存在" "d:/" "TXT" 1))
(setq file2 (open file1 "a"))
(if (setq ent (ssget '((0 . "*POLYLINE"))))
    (progn
                        (setq n1 (sslength ent))
                        (setq i1 0)
                        (while(< i1 n1)
      (setq en (ssname ent i1))
                        (setq ptl (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en))))
      (setq ss (ssget "wp" ptl '((0 . "*text"))))
                        (setq n (sslength ss))
      (setq i 0)
                        (setq ss2 " ")
               (while (< i n)
                        (setq ss1 (cdr(assoc 1 (entget(ssname ss i)))))
      (setq ss2(strcat ss1 "," ss2))
                        (setq i (1+ i))
       )
                        (write-line ss2 file2)
                        (setq i1 (1+ i1))       
    )
                )
)
        (close file2)
(princ)
)
哪位大神帮看看帮修改下，谢谢

xyp1964 发表于 2017-11-8 20:57:58

未经测试

lifuq1979 发表于 2017-11-8 22:55:27

xyp1964 发表于 2017-11-8 20:57
未经测试

谢谢大师，测试在框选范围内都是封闭区域数据导出正常，要是有其它未封闭多段线就乱了，看来还要加个判断是否闭合的语句

lifuq1979 发表于 2017-11-8 23:33:55

xyp1964 发表于 2017-11-8 20:57
未经测试

    (while (setq s1 (ssname ss (setq i (1+ i))))
                        (if (vlax-curve-isClosed s1)
      (write-line (GetTx s1) fn)))测试通过，谢谢大师

xyp1964 发表于 2017-11-9 09:07:17

lifuq1979 发表于 2017-11-8 23:33
(while (setq s1 (ssname ss (setq i (1+ i))))
                        (if (vlax-curve-isClosed s1)
      (write-li ...

(if (equal (vlax-curve-getStartPoint s1)
           (vlax-curve-getEndPoint s1)
    )
(write-line (GetTx s1) fn)
)

pengfei2010 发表于 2017-11-10 09:09:11

回帖是一种美德！感谢楼主的无私分享 谢谢
页: [1]
查看完整版本: 哪位大神帮看看问题出在哪