标注线长及统计

freedake · 发表于 2015-10-20 14:00:19

我一直想把论坛里的这两个lsp整合起来，取Free-lancer程序的提取属性信息并以此标识，和st788796程序的提取属性信息并统计制成表格；
论坛里两位老师的程序各有优势：
Free-lancer的程序提取了属性信息并标识，且统计总长；
st788796的程序可提取属性信息统计分类制成表格，但标识用的是标注方法，标注相对平面直线来说可以很好的作为标识分类，但对于空间直线会有误差；
我翻着XDRX API 2015.04.18用户手册看了一周，用飞诗编辑器一边修改一边测试，但小弟水平有限怎么测试就是不成功，貌似两位老师编写思路不大一样。

原帖地址：
标注线长并汇总总长（作者：Free-lancer）——http://www.xdcad.net/forum/forum ... read&tid=671177
杆件长度标注及统计（作者：st788796）——http://bbs.xdcad.net/forum.php?m ... 6orderby%3Ddateline

标注线长并汇总总长

freedake · 发表于 2015-10-20 15:44:18

各位帮我检查一下是否有优化的办法，我感觉这样拼凑代码的方法实在太暴力了

(defun c:xdtb_BarLength (/ _mkrotate ss lst p)
(defun gettextposition (lst)
(if (listp lst)
(progn
(setq an (xd::geom:angleformat (apply
'angle
lst
)
)
)
(polar (apply
'xdrx_line_midp
lst
) (+ an (* pi 0.5)) 1.
)
)
(xd::geom:angleformat lst)
)
)
(defun c:xdtb_linelen (/ _mkrotate ss e id pts an p p1 p2 tl l mat txt lst)
(defun _mkrotate (dim)
(xdrx_setpropertyvalue ;_xdrx_setpropertyvalue设置对象的属性值
dim "DIMBLK1" "None" "DIMBLK2" "None" "DIMDEC"
0 "DIMSAH" t "DIMSD1" t "DIMSD2"
t "DIMSE1" t "DIMSE2" t
)
)
(if (setq ss (ssget '((0 . "*polyline,line"))))
(progn
(xdrx_document_ucsoff)
(xdrx_setsstodb ss 0)
(setq tl 0.)
(while (setq e (xdrx_getentdata 0))
(setq id (xdrx_getpropertyvalue e "ObjectID")
pts (xdrx_curve_getpoint e)
typ (xdrx_getentdxf 0)
l (xdrx_getpropertyvalue e "Length")
)
(if (= typ "LINE")
(setq an (xd::geom:angleformat (angle (car pts) (caddr pts)))
p (gettextposition (list (car pts) (last pts)))
)
(progn
(setq pam (fix (xdrx_curve_getparamatpoint e (cadr pts)))
bulge (xdrx_polyline_getbulgeat e pam)
)
(if (zerop bulge)
(setq p1 (xdrx_polyline_getpointat e pam)
p2 (xdrx_polyline_getpointat e (1+ pam))
an (xd::geom:angleformat (angle p1 p2))
p (gettextposition (list (xdrx_polyline_getpointat e pam)
(xdrx_polyline_getpointat e (1+ pam))
)
)
)
(setq an (gettextposition (xdrx_curve_getfirstderiv e (cadr pts)))
p (polar (cadr pts) an 1.)
)
)
)
)
(setq tl (+ l tl))
(xdrx_text_make p (rtos l 2 0) 300. an);
)
(setq lst (vl-remove-if
'(lambda (x) (xdrx_polyline_hasbulges x)) ;_测试POLYLINE是否包含弧段
(xdrx_pickset->ents ss)
)
lst (mapcar '(lambda (x / pts)
(setq pts (xdrx_entity_getstretchpoint x)) ;_获取实体的stretch点
(if (= (length pts) 2)
(list pts)
(if (xdrx_curve_isclosed x) ;_判断两曲线是否共面
(xd::list:snakepair (xd::pnts:close pts))
(xd::list:snakepair pts)
)
)
)
lst
)
)
(mapcar '(lambda (x)
(mapcar '(lambda (a)
(_mkrotate a)
)
x
)
)
lst
)
(if (setq p (getpoint "\nPosition: "))
(progn
(setq lst (apply 'append lst)
lst (mapcar '(lambda (x)
(list (fix (+ 0.5 (apply 'distance x))) x)
)
lst
)
lst (xd::list:groupbyindex lst 0)
lst (mapcar '(lambda (x)
(list (car x) (length (cdr x)))
)
lst
)
lst (append
(mapcar '(lambda (x) (mapcar 'itoa x)) lst)
(list
(list " " (itoa (apply '+ (mapcar 'cadr lst))))
(list
"线总长"
(itoa (apply
'+
(mapcar '(lambda (x) (apply '* x)) lst)
)
)
)
)
)
lst (cons '("长度" "数量") lst)
)
(xd::table:make lst p 5.0 2.5)
)
)
(xd::end)
)
)
(princ)
)
)

(defun c:xdtb_BarLength        (/ _mkrotate ss lst p) 
  (defun gettextposition (lst) 
  (if (listp lst) 
    (progn 
      (setq an (xd::geom:angleformat (apply 
                       'angle 
                       lst 
                     ) 
           ) 
      ) 
      (polar (apply 
           'xdrx_line_midp 
           lst 
         ) (+ an (* pi 0.5)) 1. 
      ) 
    ) 
    (xd::geom:angleformat lst) 
  ) 
) 
(defun c:xdtb_linelen (/ _mkrotate ss e id pts an p p1 p2 tl l mat txt lst) 
  (defun _mkrotate (dim) 
    
    (xdrx_setpropertyvalue   ;_xdrx_setpropertyvalue设置对象的属性值 
      dim        "DIMBLK1" "None"    "DIMBLK2" "None"        "DIMDEC" 
      0                "DIMSAH"  t            "DIMSD1"  t                "DIMSD2" 
      t                "DIMSE1"  t            "DIMSE2"  t 
     ) 
  ) 
  (if (setq ss (ssget '((0 . "*polyline,line")))) 
    (progn 
      (xdrx_document_ucsoff) 
      (xdrx_setsstodb ss 0) 
      (setq tl 0.) 
      (while (setq e (xdrx_getentdata 0)) 
    (setq id (xdrx_getpropertyvalue e "ObjectID") 
          pts (xdrx_curve_getpoint e) 
          typ (xdrx_getentdxf 0) 
          l (xdrx_getpropertyvalue e "Length") 
    ) 
    (if (= typ "LINE") 
      (setq an (xd::geom:angleformat (angle (car pts) (caddr pts))) 
        p (gettextposition (list (car pts) (last pts))) 
      ) 
      (progn 
        (setq pam (fix (xdrx_curve_getparamatpoint e (cadr pts))) 
          bulge (xdrx_polyline_getbulgeat e pam) 
        ) 
        (if (zerop bulge) 
          (setq p1 (xdrx_polyline_getpointat e pam) 
            p2 (xdrx_polyline_getpointat e (1+ pam)) 
            an (xd::geom:angleformat (angle p1 p2)) 
            p (gettextposition (list (xdrx_polyline_getpointat e pam) 
                         (xdrx_polyline_getpointat e (1+ pam)) 
                       ) 
              ) 
          ) 
          (setq an (gettextposition (xdrx_curve_getfirstderiv e (cadr pts))) 
            p (polar (cadr pts) an 1.) 
          ) 
        ) 
      ) 
    ) 
    (setq tl (+ l tl)) 
    (xdrx_text_make p (rtos l 2 0) 300. an); 
      ) 
       
 
      (setq lst        (vl-remove-if 
                  '(lambda (x) (xdrx_polyline_hasbulges x))   ;_测试POLYLINE是否包含弧段 
 
                  (xdrx_pickset->ents ss) 
                ) 
            lst        (mapcar        '(lambda (x / pts) 
                           (setq pts (xdrx_entity_getstretchpoint x)) ;_获取实体的stretch点 
 
                           (if (= (length pts) 2) 
                             (list pts) 
                             (if (xdrx_curve_isclosed x) ;_判断两曲线是否共面 
 
                               (xd::list:snakepair (xd::pnts:close pts)) 
                               (xd::list:snakepair pts) 
                             ) 
                           ) 
                         ) 
                        lst 
                ) 
      ) 
      (mapcar '(lambda (x) 
                 (mapcar '(lambda (a) 
                            (_mkrotate a) 
                          ) 
                         x 
                 ) 
               ) 
              lst 
      ) 
      (if (setq p (getpoint "\nPosition: ")) 
        (progn 
          (setq        lst (apply 'append lst) 
                lst (mapcar '(lambda (x) 
                               (list (fix (+ 0.5 (apply 'distance x))) x) 
                             ) 
                            lst 
                    ) 
                lst (xd::list:groupbyindex lst 0) 
                lst (mapcar '(lambda (x) 
                               (list (car x) (length (cdr x))) 
                             ) 
                            lst 
                    ) 
                lst (append 
                      (mapcar '(lambda (x) (mapcar 'itoa x)) lst) 
                      (list 
                        (list " " (itoa (apply '+ (mapcar 'cadr lst)))) 
                        (list 
                          "线总长" 
                          (itoa        (apply 
                                  '+ 
                                  (mapcar '(lambda (x) (apply '* x)) lst) 
                                ) 
                          ) 
                        ) 
                      ) 
                    ) 
                lst (cons '("长度" "数量") lst) 
          ) 
          (xd::table:make lst p 5.0 2.5) 
        ) 
      ) 
      (xd::end) 
    ) 
  ) 
  (princ) 
) 
)

显示全部楼层 · 发表于 2015-10-23 17:05:25

提示: 作者被禁止或删除内容自动屏蔽

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

lanbordzl2015 该用户已被删除	发表于 2015-10-23 17:05:25 \| 显示全部楼层提示: 作者被禁止或删除内容自动屏蔽
lanbordzl2015 该用户已被删除	论坛插件加载方法发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
	回复使用道具举报

[求助] 标注线长及统计

相关帖子