框选线条，输出一一对应长度表格

hhjxt66

这个能写成程序么？

hhjxt66

这个能写成程序么？@

hhjxt66

这能写程序么？

newer

抽空写了个，试下，有要求在跟帖。

程序把曲线从上到下排序，首尾连接的放到表格一行，统计后生成表格。

游客，如果您要查看本帖隐藏内容请回复

hhjxt66

谢谢newer大神啊！

hhjxt66

这输出的表格还有点小问题，1有些线条长度没统计（比如第一行本来有三条线，表格只统计两条，另外那条没统计上）

newer

hhjxt66 发表于 2016-11-2 23:02

你确保他们首尾相连了吗？

把你的DWG压缩下传论坛来吧，看看。

hhjxt66

Upload Error: 503传不上呢，我明天去办公室再传传

hhjxt66

运行了，就是这样的，是我哪里操作有误么？

hhjxt66

newer 发表于 2016-11-2 23:14

帮我看看，谢谢

newer

hhjxt66 发表于 2016-11-3 20:45

修改了，加入了搜索精度距离，在精度范围内，都认为是首尾相连
我看你的图，表头没合并，你下载了最新的晓东通用LISP函数库吗？ 下载最新的，再测试代码。

(defun c:tt ( / dist1 emerge ent1 ent3 ents1 ents2 ents3 g1 g2 h i len lst lst1 rows spt ss ss1 strl tol x y)
  (xdrx_begin)
  (if (not #tongji_curve_group_tol)
    (setq #tongji_curve_group_tol 1)
  )
  (if (not #tongji_curve_group_jingdu)
    (setq #tongji_curve_group_jingdu 10)
  )
    (if (setq tol (getint (xdrx_prompt "\n搜索精度<" #tongji_curve_group_tol
                                     ">:" t
                        )
                )
      )
    (setq #tongji_curve_group_jingdu tol)
  )
  (xdrx_document_setprec #tongji_curve_group_jingdu 1)
  (if (setq tol (getint (xdrx_prompt "\n小数位数<" #tongji_curve_group_tol
                                     ">:" t
                        )
                )
      )
    (setq #tongji_curve_group_tol tol)
  )
  (xdrx_sysvar_push '("dimzin" 8))
  (if (setq ss (ssget '((0 . "*LINE"))))
    (progn
      (setq ents1 (xdrx_pickset->ents ss))
      (xdrx_setmark)
      (setq ss1 (xdrx_entity_copy ss))
      (xdrx_curve_join ss1)
      (if (setq ss1 (xdrx_getss))
        (progn
          (if (> (sslength ss1) 1)
            (setq ents2 (mapcar
                          'car
                          (XD::Pickset:TableSort ss1 0 3 '> '>)
                        )
            )
            (setq ents2 (xdrx_pickset->ents ss1))
          )
          (setq ents3 ent1
                rows (length ents2)
                i 0
          )
          (setq lst nil
                lst1 nil
          )
          (repeat rows
            (setq emerge (nth (1- (setq i (1+ i))) ents2))
            (setq g1 (xdge::constructor emerge))
            (setq lst1 nil)
            (mapcar
              '(lambda (x)
                 (setq g2 (xdge::constructor x))
                 (if (apply 'and  (mapcar '(lambda(x)(xdge::getpropertyvalue g1 "ison" x)) (xdge::getpropertyvalue g2 "getsamplepoints" 2)))
                   (progn
                     (setq ents3 (vl-remove x ent3))
                     (setq spt (xdrx_getpropertyvalue x "startpoint")
                           dist1 (xdrx_curve_getdistatpoint emerge spt)
                     )
                     (setq len (xdrx_getpropertyvalue x "length"))
                     (setq lst1 (cons (list dist1 (rtos len 2 #tongji_curve_group_tol))
                                      lst1
                                )
                     )
                   )
                 )
               )
              ents1
            )
            (xdge::free (list g1 g2))
            (setq lst1 (vl-sort lst1 '(lambda (x y)
                                        (< (car x) (car y))
                                      )
                       )
            )
            (setq lst (cons (cons (itoa i) (mapcar
                                             'cadr
                                             lst1
                                           )
                            ) lst
                      )
            )
          )
          (xdrx_entity_delete ents2)
          (setq lst (reverse lst))
          (setq lst (XD::Table:FillGap lst "")
                len (1- (length (car lst)))
          )
          (setq i 0
                strl nil
          )
          (repeat len
            (setq strl (cons (strcat "长度" (itoa (setq i (1+ i)))) strl))
          )
          (setq lst (cons (cons "序 号" (reverse strl)) lst))
          (setq lst (cons (list "曲线长度统计表") lst)
                lst (XD::Table:FillGap lst "")
          )
          (xd::text:init 1)
          (setq h (* 4 (xd::var:getratio) (xd::var:getscaleratio)))
          (xd::table:makefromlist lst '(0 0 0) h (/ h 2.0))
          (XD::Drag:SimpleMove (entlast) "\n表格插入点:" 8 t)
        )
      )
    )
  )
  (xdrx_sysvar_pop)
  (xdrx_end)
  (princ)
)

hhjxt66

好的，我下载了最新的再试试

hhjxt66

不错，不错，辛苦啦！！！

newer

hhjxt66 发表于 2016-11-3 22:59

可以了？ 做一个你工作的实际例子的动画贴论坛来吧。

hhjxt66

我这表头还是没能合并，其他都OK，你说的最新函数库是这个么？
命令: _appload 已成功加载 xd-lisp-lib.VLX。
晓东通用LISP函数库Build 2016.10.28加载完毕...