lisp能否实现四叉树算法？

20060510412 · 发表于 2024-3-8 11:38:02

最近有个需求，不知如何实现，情况如下：

dwg中有一万个点，指定某点，找出至该点特定距离范围内的所有点。

使用lisp直接进行遍历，再判断距离肯定可以解决问题，但是效率太低下。

经过了解，发现四叉树之类的算法可以进行快速计算，但不知道用lisp能否实现四叉树算法呢？

xyp1964 · 发表于 2024-3-8 13:15:44

本帖最后由 xyp1964 于 2025-2-20 19:51 编辑

(defun abc (pt dd / i p1 p2 s1 ss ss1)
;; (sssetfirst nil (abc (getpoint) 10000))
(setq p1 (mapcar '+ pt (list (- dd) (- dd)))
p2 (mapcar '+ pt (list dd dd))
ss1(ssadd)
i -1
)
(if (setq ss (ssget "c" p1 p2 '((0 . "point"))))
(while (setq s1 (ssname ss (setq i (1+ i))))
(if (<= (distance (cdr (assoc 10 (entget s1))) pt) dd)
(ssadd s1 ss1)
)
)
)
ss1
)

kozmosovia · 发表于 2024-3-8 12:36:39

lisp可以根据已知的点计算获取范围的矩形角点直接选点，没必要遍历所有点。

dcl1214 · 发表于 2024-3-14 14:37:26

(defun c:zdlj (/    a    b    dxf dxf2  ents  ents2 es jb
         jb2 jb-ks jb-pt jdcds l    old old-cdr    p
         p2 ss
      )
;最短路径
  (vl-catch-all-apply 'load (list (findfile "zdlj.vlx")))
;声明引用zdlj.vlx这个模块
  (vl-catch-all-apply 'vl-doc-import (list "zdlj")) ;声明引用函数
  (SETQ JDCDS NIL)
  (SETQ ES NIL)
  (setq jb-pt nil)
  (SETQ SS (SSGET))
  (and ss(setq ents (vl-remove-if
         (function listp)
         (mapcar (function cadr) (ssnamex SS))
      )
  ))
  (setq jb-ks nil)
  (while (setq a (car ents))
(setq dxf nil)
(setq jb nil)
(setq p nil)
(setq ents2 nil)
(setq dxf (entget a))
(setq jb (cdr (assoc 5 dxf)))
(setq p (cdr (assoc 10 dxf)))
(setq ents2 (cdr ents))
(while (setq b (car ents2))
   (setq dxf2 nil)
   (setq jb2 nil)
   (setq p2 nil)
   (setq l nil)
   (setq old nil)
   (setq old-cdr nil)
   (setq dxf2 (entget B))
   (setq jb2 (cdr (assoc 5 dxf2)))
   (setq p2 (cdr (assoc 10 dxf2)))
   (SETQ L (DISTANCE P P2))
   (SETQ L (VL-PRINC-TO-STRING L))
   (setq old (assoc jb jb-ks));建立索引
   (setq old-cdr (cdr old))
   (setq old-cdr (cons (CONS (cons JB JB2) L) old-cdr))
   (setq jb-ks (vl-remove old jb-ks))
   (setq jb-ks (cons (cons jb old-cdr) jb-ks)) ;建立数据库索引
   (setq ents2 (cdr ents2))
)
(setq jb-pt (cons (cons jb p) jb-pt)) ;建立数据库索引
(setq ents (cdr ents))
  )
  (setq
jb-ks
   (mapcar
   (function
   (lambda (a)
   (cons
      (car a)
      (vl-sort (cdr a)
      (function (lambda (x y) (< (cdr x) (cdr y))))
      )
   )
   )
   )
   jb-ks
   )
  )
  (setq jb-ks (reverse jb-ks))
  (mapcar (function (lambda (a / e1 e2 p1 p2)
      (setq e1 (car a))
      (setq e2 (cdr (car (car (cdr a)))))
      (setq p1 (cdr (assoc e1 jb-pt))) ;启用索引
      (setq p2 (cdr (assoc e2 jb-pt))) ;启用索引
      (and p1
   p2
   (vla-addLine
      (vla-Get-ModelSpace
         (vla-get-ActiveDocument
   (vlax-get-acad-object)
         )
      )
      (vlax-3D-Point p1)
      (vlax-3D-Point p2)
   )
      )
      )
   )
   jb-ks
  )
)

liuhe · 发表于 2024-3-8 12:11:44

可以实现，但是不建议，因为会卡死

20060510412 · 发表于 2024-3-8 14:50:16

谢谢，ssget的方法我也知道，只是对这个四叉树比较好奇，还以为可以大幅加快计算速度。
我看arx的四叉树算法计算速度就挺快的啊，网址：http://bbs.mjtd.com/forum.php?mo ... E6%CA%F7&page=1

20060510412 · 发表于 2024-3-8 14:52:53

https://zhuanlan.zhihu.com/p/93423676
看这个网址的介绍，四叉树遍历与全图遍历相比，时间会大幅度节省。
难道是lisp实现四叉树本身，就比较浪费时间么？

你有种再说一遍 · 发表于 2024-3-8 17:22:34

本帖最后由你有种再说一遍于 2024-3-8 17:25 编辑

不是lisp实现不了,只是这个数据结构写起来麻烦,
c#和arx的都写好了,抄抄就好了
https://www.cnblogs.com/JJBox/p/15512317.html
而且为什么说麻烦,因为你之后还有红黑树,还有hashmap,还有hashset,还有多线程...
不要想不开在lisp实现,lisp讲的就是暴力遍历

20060510412 · 发表于 2024-3-8 17:40:44

你有种再说一遍发表于 2024-3-8 17:22
不是lisp实现不了,只是这个数据结构写起来麻烦,
c#和arx的都写好了,抄抄就好了
https://www.cnblogs.co ...

好的，了解了，杀鸡不用牛刀，反之亦然。

你有种再说一遍 · 发表于 2024-3-8 20:22:57

本帖最后由你有种再说一遍于 2024-3-8 22:07 编辑

20060510412 发表于 2024-3-8 17:40
好的，了解了，杀鸡不用牛刀，反之亦然。

是的,如果你想学,那我就告诉你抄多方便,去哪里抄?换一个语言抄,趁机学一门新语言吧...如果你非要在lisp实现,那么我还得告诉你一些弊端,例如递归层数和树高控制(lisp在递归太深会溢出栈,这个栈大小没法设置)...然后看看测试代码行数,会得到一个结论:优化和测试才是关键,功能谁不会写...

Dea25 · 发表于 2024-3-8 21:17:50

一行代码，10W点秒出，

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

[提问] lisp能否实现四叉树算法？

本帖子中包含更多资源

点评