Kablamtron 发表于 2022-7-6 09:14:16

通过Elevat为点云着色

大家好,
 
我正在使用Autocad 2002-2011。
 
我有一个很大的点云,通常大约100000个点,也许更多,不幸的是,程序将这些点发送到autocad的唯一方式是纯白色。
 
在我尝试制作一些lisp之前,我只是想知道是否有人有一个lisp,可以根据点云的高程为其着色。
 
我所说的颜色是指一系列的颜色,所以当我从俯视角度观察这些点时,我可以看到海拔的差异。
 
如果没有,我打算设计一些工作方式,例如将所有点收集到一个数组中,然后根据从最高点Z值到最低点Z值的范围对其进行排序,将颜色分配给点海拔的分割百分比,即红色0-10%蓝色11-20%,依此类推。
 
任何人,如果有人知道Lisp程序已经做了类似的事情给我一个叫!
 
谢谢
 
卡布拉姆特隆

BlackBox 发表于 2022-7-6 09:21:17

我没有为您准备的例程,因为我很少使用点云,但您可以尝试开发一些东西,逐步通过过滤的点选择集,并使用cond语句检查点高程,然后使用vla put color函数相应地更改点颜色。
 
编辑:
然而,如果您想通过您概述的百分比括号对点高程进行排序,我相信您可能需要两次遍历选择集。。。
 
第一次在排序列表中构造高程和vla对象的分组对,并获取总计数,第二次通过单步遍历排序列表,拉动vla对象引用(cadr?)并应用颜色。
 
希望这有帮助!

alanjt 发表于 2022-7-6 09:22:50

您可以创建一个点对列表(Elev.EName)来按您喜欢的方式分解并进行相应的修改-我只需要使用entmod。
 
例如(创建点对列表)
(defun foo (/ ss)
(if (setq ss (ssget "_X" '((0 . "POINT"))))
   ((lambda (i / e l)
      (while (setq e (ssname ss (setq i (1+ i))))
      (setq l (cons (cons (last (assoc 10 (entget e))) e) l))
      )
      (vl-sort l (function (lambda (a b) (< (car a) (car b)))))
    )
   -1
   )
)
)
 
例如(用确定的颜色修改)
(defun foo (l c)
(entupd (cdr (assoc -1
                     (entmod (if (assoc 62 l)
                               (subst (cons 62 c) (assoc 62 l) l)
                               (append l (list (cons 62 c)))
                           )
                     )
            )
         )
)
)
(foo(entget)3)

David Bethel 发表于 2022-7-6 09:28:09

我喜欢百分比法
 
颜色1=0-10%
颜色2=10.0001-20%
颜色3=20.0001-30%
 

 

(defun c:pelcl (/ ss i en ed ev el minz delta pc nc)
(if (setq ss (ssget "X" '((0 . "POINT"))))
   (progn
      (setq i (sslength ss))
      (while (setq en (ssname ss (setq i (1- i))))
               (setq ed (entget en)
                     ev (caddr (cdr (assoc 10 ed)))
                     el (cons ev el)))
      (setq minz (apply 'min el)
             delta (- (apply 'max el) (apply 'min el))
                  i -1)
      (while (setq en (ssname ss (setq i (1+ i))))
               (setq ed (entget en)
                     ev (caddr (cdr (assoc 10 ed)))
                     pc (cdr (assoc 62 ed))
                     nc (- 10 (abs (fix (/ (- delta (- ev minz) 1e-4) delta 0.1))))
                     ed (if pc (subst (cons 62 nc) (cons 62 pc) ed)
                               (append ed (list (cons 62 nc)))))
               (entmod ed))))
(prin1))

 
 
颜色1+10在我的设置中相当接近,但我仍然可以区分。祝你好运-大卫

BlackBox 发表于 2022-7-6 09:32:48

正如一位智者所说。。。
 
 
 
英雄联盟
 
编辑:顺便说一句,很棒的家伙!

Kablamtron 发表于 2022-7-6 09:33:15

哇哈哈,
 
嗯,我本来打算写例行笑,但伙计,你们太快了!
 
大卫,我试过了,效果很好。
 
谢谢alan和david,谢谢你们的输入,谢谢你们写出这么好的lisp。
 
再次感谢各位!
 
卡布拉姆特隆

David Bethel 发表于 2022-7-6 09:38:12

不客气。
 
我会发现这种变化在我的工作中很有用
 
这里有一个更紧凑的例子:
 

(defun c:pelcl (/ ss i en ed ev el minz delta pc nc)
(and (setq i -1 ss (ssget "X" '((0 . "POINT"))))
      (while (setq en (ssname ss (setq i (1+ i))))
             (setq ed (entget en)
                   el (cons (caddr (cdr (assoc 10 ed))) el)))
      (setq minz (apply 'min el)
         delta (- (apply 'max el) minz))
      (while (setq en (ssname ss (setq i (1- i))))
             (setq ed (entget en)
                   ev (caddr (cdr (assoc 10 ed)))
                   pc (cdr (assoc 62 ed))
                   nc (- 10 (abs (fix (/ (- delta (- ev minz) 1e-4) delta 0.1))))
                   ed (if pc (subst (cons 62 nc) (cons 62 pc) ed)
                           (append ed (list (cons 62 nc)))))
             (entmod ed)))
(prin1))

 
 
-大卫

alanjt 发表于 2022-7-6 09:44:18

总是乐于助人。

Kablamtron 发表于 2022-7-6 09:47:20

大家好,
 
我在看输出,它产生的百分比带有点宽
 
0-10%蓝色
10.005-20%红色
 
我想我会尝试将lisp更改为rgb true Color,原理与之前相同,但更像:
 
r 0 g 255 b 0.1%-0.2%
r 1 g 255 b 0 0.2%-0.3%等等,只需穿过整个颜色范围,就能看到更细微的海拔变化。
 
我会张贴它当我完成!
 
像往常一样谢谢你的帮助
 
卡布拉姆特隆

BlackBox 发表于 2022-7-6 09:48:51

 
 
... 这篇文章接着说:“呃,看看那边那只死松鼠……”
 
“没有!”
页: [1] 2
查看完整版本: 通过Elevat为点云着色