admin 发表于 2024-3-16 20:40:42

lisp能否实现四叉树算法

;;参数 pt 位置点坐标
;;   jd 查找半径
(defun gxl-sel-SSgetByPoint (pt jd / px py px0 px1 py0 py1 ss pz rtn e)
(setqpx(car pt)
px0 (- px jd)
px1 (+ px jd)
py(cadr pt)
py0 (- py jd)
py1 (+ py jd)
pz 1e99
)

(setqss
   (ssget"x"
    (list '(0 . "point")
          '(-4 . "<and")
          '(-4 . ">=,>=,<>")
          (list 10 px0 py0 pz)
          '(-4 . "<=,<=,<>")
          (list 10 px1 py1 pz)
          '(-4 . "and>")
    )
   )
)
(if ss
    (progn
      (repeat (setq n (sslength ss))
(if (<= (distance (list (car pt) (cadr pt)) (cdr (assoc 10 (entget (setq e (ssname ss (setq n (1- n)))))))) jd)
    (setq rtn (cons e rtn))
    )
)
      )
)
;;颜色变红提示
(foreach e rtn (entmod (append (entget e) '((62 . 1)))))
;;返回选中点图元名列表
rtn
)
;;测试
(defun c:tt (/ pt jd)
(setq rtn (gxl-sel-SSgetByPoint (setq pt (getpoint "\n位置点:")) (setq jd (getdist pt "\n半径:"))))
(command "circle" "采用non" pt jd)
(princ (strcat "\n选中" (itoa (length rtn)) "个点."))
(princ)
)

admin 发表于 2024-3-16 20:41:05

(defun c:zdlj (/   a         b         dxf   dxf2entsents2 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
)
)
页: [1]
查看完整版本: lisp能否实现四叉树算法