一个矩形统计工具，想请各位大佬帮忙改改

行雲

原程序是个矩形长宽尺寸统计的程序，以列表形式列出矩形长宽尺寸。

我在程序中加了两行，提取图层名。但在循环时图层名不能更替。如图：


想请各位大佬出手帮忙改改。以层名为根，像下图那样：



(defun qbc (pts / n bc_list b h pt1 pt2 pt3 pt4)
        (setq n 0 bc_list nil)
        (setq pt1 (nth n pts))
        (setq pt2 (nth (+ 1 n) pts))
        (setq pt3 (nth (+ 2 n) pts))
        (setq pt4 (nth (+ 3 n) pts))
        (setq b (distance pt1 pt4))
        (setq h (distance pt1 pt2))
        (setq bc_list (cons b h))
      );结束子函数
  
(defun c:tg (  / bclst pts ss el bc_new i p1 p3 m x1 x2)
   (setvar "cmdecho" 0)
   (setq os (getvar "osmode"))
   (setq clay (getvar "clayer"))
   (setvar "osmode" 0)
   (command "layer" "s" "DIM" "")
   ;(setvar "lunits" 1)
   (princ "\n框选矩形:")
   (setq ss (ssget '((0 . "LWPOLYLINE"))))
   ;(setq ee (ssname ss 0))
   (setq i 0 x 0 bclst nil pts nil bc_new nil)
   ;(setq la (cdr (assoc 8 (entget ee))))
   (setq x (sslength ss))
   (repeat x
               (setq el (entget (ssname ss i)))
               (setq la (cdr (assoc 8 el)));;;;;;;;;;;;;;;;;;;;;;加了一句 获得图元层名
               (foreach pt el
                    (if (= (car pt) 10)
                        (setq pts (append pts (list (cdr pt))))
                     );结束IF
                 );结束foreach遍历元素      
                (setq bc (qbc pts))
                (setq bclst(cons bc bclst))
                (setq pts nil)
               ;(setq la (cdr (assoc 8 (entget ee))))
                (setq i (+ 1 i))
             );结束repeat         
         
    (setq bc_new nil)
    (while bclst
          (setq m (car bclst) x1 (length bclst))
          (setq bclst (vl-remove m bclst))
          (setq x2 (length bclst))
          (setq n (- x1 x2))
          (setq bc_new (cons (append (list m) (list n))bc_new))
    )
   (setq p1 (getpoint "\起始位置"))
   (setq p2 (polar p1  0 60))
   (setq p3 (polar p2  0 56))
   (setq ph (polar p1 (* pi 1.5) 2.5))
   (setq pha (polar ph (* pi 1) 15))
   (setq phb (polar pha 0 150))
      (command "text" "j" "c" (polar p1 (* pi 0.5) 10) "5" "0" "层名")
      (command "text" "j" "c" (polar p2 (* pi 0.5) 10) "5" "0" "尺寸")
      (command "text" "j" "c" (polar p3 (* pi 0.5) 10) "5" "0" "数量")
      (command "line" pha phb "")
    (foreach bg bc_new
    (command "text" "j" "c" p1 "5" "0" la) ；；；加了一句 标写层名
    (command "text" "j" "c" p2 "5" "0" (strcat (rtos (car (car bg)) 2)"*"(rtos (cdr (car bg))2)))；；；长宽尺寸
    (command "text" "j" "c" p3 "5" "0" (cadr bg))
     (command "line" pha phb "")
     (setq p1 (polar p1 (* pi 1.5) 12))
     (setq p2 (polar p1  0 60))
     (setq p3 (polar p2  0 56))
     (setq pha (polar pha (* pi 1.5) 12))
     (setq phb (polar phb (* pi 1.5) 12))
     )
     ;(setvar "lunits" 4)
     (setvar "osmode" os)
     (command "layer" "S" clay  "")
     (princ)
   )

newer

以后提问时候，需要同时提供你的DWG图上来，要不别人怎么帮你测试呢

行雲

newer 发表于 2016-12-1 17:38

谢谢老大相助，，，图形就是几个方框，有图层属性

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:1.rar 
下载次数:22  文件大小:168.85 KB 
下载权限: 不限 以上  [免费赚D豆]

newer

行雲 发表于 2016-12-1 21:10

虽然是几个图形，你有现成的，也不好让帮你的人在画吧。

还有，改别人的代码很麻烦的事，尤其是一大推括号的LISP语言，你说是帮你修改你的代码，还是重新写个，告诉你这样的应用最好怎么写呢

行雲

newer 发表于 2016-12-1 21:58

重写工作量大不？如果过大也不好相求，谢谢你

我简单以为，只要再循环时，稍作改动就可以了。。。。

newer

行雲 发表于 2016-12-1 22:35

抽空帮你写个，你想的是对的，可是你的代码里面，获得层名是在循环里面吗？ 你要把循环里面得到的每个层赋给一个表保存起来才行，你一直获得一直覆盖了，就想那啥掰苞米。你看看获得长宽那些代码，是不是有 cons 把每个得到的值都添加一个表里面保存了？

行雲

newer 发表于 2016-12-2 00:00

那我就先多谢你了。贵人相助，，这完意我弄了好久，基础太差，始终不得要领，，程序原本是别人的，我只在里面插了几句。

希望程序能实现下图效果，以层名为纲，，，

                               
登录/注册后可看大图

最好能有个接口，可将层名转换为另一种信息
像这样：
统计变化中的层名自动对应各自的转换信息
(setq  cengming )
(cond
  ((= la_new "DIM") (尺寸))
  ((= la_new "P03") (总装图))
)
输出时。用这个转变过的变量cengming  
(command "text" "j" "c" p1 "5" "0" cengming)

newer

行雲 发表于 2016-12-2 00:34

多利用别人写的函数，尤其是初学，我们写不是靠写程序吃饭，都有实际的专业，如果有现成的代码，效率会很高，而且平时要多看别人的代码。

你先去 开源函数库， 搜索 xd::list:groupbyindex 函数，把这个理解了，就是做统计用的函数。

newer

行雲 发表于 2016-12-2 00:34

                               
登录/注册后可看大图

去看下这个帖子，里面的按图层统计， 把表格第三列线长的部分改成  长*宽，就是你要的了。

http://bbs.xdcad.net/thread-705859-1-1.html

行雲

newer 发表于 2016-12-2 09:10

多谢，，，，，

longer1000

珍惜生命，果断回帖。

wjy1998