重复块查找并标记

865643309 · 发表于 2016-4-25 08:26:27

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

我在做地名普查，野外采集地名点时同一个地方采了重复的点，有好多这样的重复点、距离小于3米的点，这些点怎么找出来并做个标记？
无标题.png

newer · 发表于 2016-4-25 08:43:54

不是一个专业，你想怎么注记？最好附上个图，并且截取个清楚的局部的图片说明下。

865643309 · 发表于 2016-4-25 09:05:07

大概就是这样的图

XDSoft · 发表于 2016-4-25 10:01:53

论坛来的朋友各行各业，隔行如隔山，你详细和一个不是你专业的人说下，从头到尾你想做什么，在CAD图中，你手工是怎么操作的，如选什么实体处理，根据什么处理，要处理成什么样子，把详细的步骤说出来，让大家知道怎么写程序帮你提高效率。

865643309 · 发表于 2016-4-26 12:45:27

重复块的查找并标记

newer · 发表于 2016-4-26 19:09:31

本帖最后由 newer 于 2016-4-26 19:23 编辑

865643309 发表于 2016-4-26 12:45
重复块的查找并标记

写了一个，试试，先去下载老大今天更新的通用LISP函数库，http://bbs.xdcad.net/thread-669133-1-1.html ，覆盖到工具箱安装SYS目录下。

录像11_转.gif

程序功能是根据容差查找可能重叠或过近的图块并做标记。

(defun c:tt ()
(xdrx_begin)
(if (not #XD_GLOBAL_VAR_TOL)
(setq #XD_GLOBAL_VAR_TOL 20.0)
)
(if (setq tol (getreal (xdrx_prompt "\n输入查询模糊精度<"
#XD_GLOBAL_VAR_TOL ">:" t
)
)
)
(setq #XD_GLOBAL_VAR_TOL tol)
)
(prompt "\n选取查询的图块<退出>:")
(if (setq ss (ssget '((0 . "insert"))))
(progn
(setq i 0
j 0
)
(xdrx_setsstodb ss 0)
(while (setq e (xdrx_getentdata 0))
(setq cen (XD::Geom:Get9PT e 5)
pnts (XD::Pnt:GetCirPnts cen #XD_GLOBAL_VAR_TOL)
ss1 (ssget "cp" pnts '((0 . "insert")))
)
(if (and
ss1
(> (sslength ss1) 1)
)
(progn
(setq i (+ i (sslength ss1)) len (/ #XD_GLOBAL_VAR_TOL 5.0))
(setq e (XD::Entity:Clound ss1 len len))
(xdrx_setpropertyvalue (entlast) "color" 2 "ConstantWidth" 1.0)
)
(setq j (1+ j))
)
)
(if (> i 0)
(xdrx_prompt "\n当前选集查到重叠的块，已做标记。")
(xdrx_prompt "\n当前选集没有查到重叠的块。")
)
)
)
(xdrx_end)
(princ)
)

(defun c:tt () 
  (xdrx_begin) 
  (if (not #XD_GLOBAL_VAR_TOL) 
    (setq #XD_GLOBAL_VAR_TOL 20.0) 
  ) 
  (if (setq tol (getreal (xdrx_prompt "\n输入查询模糊精度<" 
                                      #XD_GLOBAL_VAR_TOL ">:" t 
                         ) 
                ) 
      ) 
    (setq #XD_GLOBAL_VAR_TOL tol) 
  ) 
  (prompt "\n选取查询的图块<退出>:") 
  (if (setq ss (ssget '((0 . "insert")))) 
    (progn 
      (setq i 0 
            j 0 
      ) 
      (xdrx_setsstodb ss 0) 
      (while (setq e (xdrx_getentdata 0)) 
        (setq cen (XD::Geom:Get9PT e 5) 
              pnts (XD::Pnt:GetCirPnts cen #XD_GLOBAL_VAR_TOL) 
              ss1 (ssget "cp" pnts '((0 . "insert"))) 
        ) 
        (if (and 
              ss1 
              (> (sslength ss1) 1) 
            ) 
          (progn 
            (setq i (+ i (sslength ss1)) len (/ #XD_GLOBAL_VAR_TOL 5.0)) 
            (setq e (XD::Entity:Clound ss1 len len)) 
            (xdrx_setpropertyvalue (entlast) "color" 2 "ConstantWidth" 1.0) 
          ) 
          (setq j (1+ j)) 
        ) 
      ) 
      (if (> i 0) 
        (xdrx_prompt "\n当前选集查到重叠的块，已做标记。") 
        (xdrx_prompt "\n当前选集没有查到重叠的块。") 
      ) 
    ) 
  ) 
  (xdrx_end) 
  (princ) 
)

865643309 · 发表于 2016-4-26 20:44:01

我试了一下很不错，想要实现的就是这样，版主的标记做的复杂了。谢谢版主，我正在学习vlisp,有什么群可以加入吗？

newer · 发表于 2016-4-26 21:04:14

865643309 发表于 2016-4-26 20:44
我试了一下很不错，想要实现的就是这样，版主的标记做的复杂了。谢谢版主，我正在学习vlisp,有什么群可以加 ...

个人认为群没论坛方便，群里面讨论过的后来想看就不好找了，论坛可以一直搜索到很久以前的帖子，有问题还是在论坛发帖吧，求助或者帮助别人，经验都是在帮助别人的同时自己活得的。欢迎常来。

多看看论坛以前的帖子，可以说这个论坛VLISP讨论过的包罗万象了。

欢迎常来！

eachy · 发表于 2016-4-27 12:36:38

直接用xd::list:groupby还简单

st788796 · 发表于 2016-5-4 11:07:39

本帖最后由 st788796 于 2016-5-4 11:38 编辑

改造下 Clound 函数，Alisp 使用中经常用到的三种形式 ENAME PICKSET 还有 ENAME List

;|
实体包围盒云线
参数： ss -- 点表 or 实体、选择集
al -- 弦长
len 偏移距离
返回：：实体名
|;
(defun XD::Entity:Clound (ss al len / pl l n sp d p1 i pts nums bulge)
(cond
((= (type ss) 'PICKSET)
(setq pl (apply
'xdrx_polyline_make
(cons t (xdrx_entity_box ss))
)
)
)
((and (= (type ss) 'LIST) (= (type (car ss)) 'LIST))
(setq pl (apply
'xdrx_polyline_make
(cons t (xdrx_entity_box ss))
)
)
)
((or (= (type ss) 'ENAME)
(and (= (type ss) 'LIST) (= (type (car ss)) 'ENAME))
)
(setq pl (apply 'xdrx_polyline_make
(cons t
(xdrx_entity_box
(if (= (type ss) 'ENAME)
ss
(xd::entity->pickset ss)
)
)
)
)
)
)
(t)
)
(if pl
(progn
(setq l (cadr (xdrx_getarea pl))
n (1+ (fix (/ l al)))
sp (xdrx_curve_getstartpoint pl)
d 0.
)
(repeat n
(setq p1 (xdrx_curve_getpointatdist pl d)
d (+ d al)
pts (cons p1 pts)
)
)
(xdrx_entity_delete pl)
(setq pl (apply
'xdrx_polyline_make
(cons t (apply 'xdrx_points_offset (cons len pts)))
)
nums (xdrx_polyline_numverts pl)
i 0
bulge (- (xdrx_math_tan (* (/ 27.5 180) pi)))
)
(repeat nums
i
(xdrx_polyline_setbulgeat pl i bulge)
(setq i (1+ i))
)
)
)
pl
)

;| 
实体包围盒云线 
参数： ss -- 点表 or 实体、选择集 
      al -- 弦长 
     len 偏移距离 
返回：：实体名 
|; 
(defun XD::Entity:Clound (ss al len / pl l n sp d p1 i pts nums bulge) 
  (cond 
    ((= (type ss) 'PICKSET) 
     (setq pl (apply 
                'xdrx_polyline_make 
                (cons t (xdrx_entity_box ss)) 
              ) 
     ) 
    ) 
    ((and (= (type ss) 'LIST) (= (type (car ss)) 'LIST)) 
     (setq pl (apply 
                'xdrx_polyline_make 
                (cons t (xdrx_entity_box ss)) 
              ) 
     ) 
    ) 
    ((or (= (type ss) 'ENAME) 
         (and (= (type ss) 'LIST) (= (type (car ss)) 'ENAME)) 
     ) 
     (setq pl (apply 'xdrx_polyline_make 
                     (cons t 
                           (xdrx_entity_box 
                             (if (= (type ss) 'ENAME) 
                               ss 
                               (xd::entity->pickset ss) 
                             ) 
                           ) 
                     ) 
              ) 
     ) 
    ) 
    (t) 
  ) 
  (if pl 
    (progn 
      (setq l  (cadr (xdrx_getarea pl)) 
            n  (1+ (fix (/ l al))) 
            sp (xdrx_curve_getstartpoint pl) 
            d  0. 
      ) 
      (repeat n 
        (setq p1  (xdrx_curve_getpointatdist pl d) 
              d          (+ d al) 
              pts (cons p1 pts) 
        ) 
      ) 
      (xdrx_entity_delete pl) 
      (setq pl          (apply 
                    'xdrx_polyline_make 
                    (cons t (apply 'xdrx_points_offset (cons len pts))) 
                  ) 
            nums  (xdrx_polyline_numverts pl) 
            i          0 
            bulge (- (xdrx_math_tan (* (/ 27.5 180) pi))) 
      ) 
      (repeat nums 
        i 
        (xdrx_polyline_setbulgeat pl i bulge) 
        (setq i (1+ i)) 
      ) 
    ) 
  ) 
  pl 
)

st788796 · 发表于 2016-5-4 11:43:07

ssget 点表方式的限制就是遇到屏幕边缘时，如果点超出了屏幕就会选择不到，使用 GroupByIndex 就可以避免这个情况，用上面修改的函数，主程序如下

(defun c:tt (/ ss tol lst)
(xdrx_begin)
(if (not #XD_GLOBAL_VAR_TOL)
(setq #XD_GLOBAL_VAR_TOL 20.0)
)
(if (setq tol (getdist (xdrx_prompt
"\n输入查询模糊精度<"
#XD_GLOBAL_VAR_TOL
">:"
t
)
)
)
(setq #XD_GLOBAL_VAR_TOL tol)
)
(prompt "\n选取查询的图块<退出>:")
(if (setq ss (ssget '((0 . "insert"))))
(progn
(setq lst (mapcar '(lambda (x / box)
(setq box (xdrx_entity_box x))
(list (polar (car box)
(angle (car box) (caddr box))
(/ (distance (car box) (caddr box)) 2)
)
x
)
)
(xdrx_pickset->ents ss)
)
lst (xd::list:groupbyindex lst #XD_GLOBAL_VAR_TOL)
)
(mapcar '(lambda (x)
(if (> (length (cdr x)) 1)
(xd::entity:clound
(cdr x)
(/ #XD_GLOBAL_VAR_TOL 5.0)
(/ #XD_GLOBAL_VAR_TOL 5.0)
)
)
)
lst
)
)
)
(princ)
)

(defun c:tt (/ ss tol lst) 
  (xdrx_begin) 
  (if (not #XD_GLOBAL_VAR_TOL) 
    (setq #XD_GLOBAL_VAR_TOL 20.0) 
  ) 
  (if (setq tol        (getdist (xdrx_prompt 
                           "\n输入查询模糊精度<" 
                           #XD_GLOBAL_VAR_TOL 
                           ">:" 
                           t 
                         ) 
                ) 
      ) 
    (setq #XD_GLOBAL_VAR_TOL tol) 
  ) 
  (prompt "\n选取查询的图块<退出>:") 
  (if (setq ss (ssget '((0 . "insert")))) 
    (progn 
      (setq lst        (mapcar        '(lambda (x / box) 
                           (setq box (xdrx_entity_box x)) 
                           (list (polar        (car box) 
                                        (angle (car box) (caddr box)) 
                                        (/ (distance (car box) (caddr box)) 2) 
                                 ) 
                                 x 
                           ) 
                         ) 
                        (xdrx_pickset->ents ss) 
                ) 
            lst        (xd::list:groupbyindex lst #XD_GLOBAL_VAR_TOL) 
      ) 
      (mapcar '(lambda (x) 
                 (if (> (length (cdr x)) 1) 
                   (xd::entity:clound 
                     (cdr x) 
                     (/ #XD_GLOBAL_VAR_TOL 5.0) 
                     (/ #XD_GLOBAL_VAR_TOL 5.0) 
                   ) 
                 ) 
               ) 
              lst 
      ) 
    ) 
  ) 
  (princ) 
)

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

[求助] 重复块查找并标记

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评