Bane 发表于 2022-7-6 17:30:06

查找与lin连接的点

大家好,
我使用ssget函数选择图形中的所有点图元。我需要某种过滤器来只选择那些代表现有直线或多段线起点或终点的点。其他(自由)点应排除在选择集中。
 
欢迎任何帮助。
非常感谢。

fixo 发表于 2022-7-6 17:37:20

试试看
测试不够
 

;; local defun
(defun _remove-points(/ en i pe pt sscol ssl ssp)
(setq sscol (ssadd))
(setq ssp (ssget "_X" (list
             (cons 0 "POINT")
               (cons 410 (getvar "CTAB")))))
(setq i -1)
(while (setq en (ssname ssp (setq i (1+ i))))
      (setq pt (cdr (assoc 10 (entget en))))
(if(setq ssl (ssget "C" (list (car pt)(cadr pt))
                (list (car pt)(cadr pt))
                (list
                  (cons 0 "LINE,*POLYLINE")
                  (cons 410 (getvar "CTAB")))))
   (progn
   (setq pe (ssname ssl 0))
   (if (or
    (equal (vlax-curve-getclosestpointto pe pt)
                   (vlax-curve-getstartpoint pe) 0.00001)
    (equal (vlax-curve-getclosestpointto pe pt)
                  (vlax-curve-getendpoint pe) 0.00001))
(ssadd en sscol); gather the desired points into separate selection set
)
   ))
)
sscol ;<-- return selection set with desired points
)
;; usage:
(defun C:test ()
(setq ss (_remove-points))
(alert (strcat "Desired points found: " (itoa (sslength ss))))
(princ)
)
(vl-load-com)

此函数用于加载ActiveX DLL(VLA函数)
我编辑了上面的代码,请重试
顺便说一句,仅在2008年测试
 
~'J'~

Bane 发表于 2022-7-6 17:46:11

就是这样。非常感谢。
 
还有一个问题,但可能是AutoCads的bug。我通过在新的选择集中的点上插入圆来完成这段代码。如果我放大“范围”,一些应该有圆的点会被忽略。如果我放大到这一点,然后再次启动这段代码,一切都很好。
 
我可以接受。
 
谢谢你的帮助。
 
最美好的祝福。

fixo 发表于 2022-7-6 17:52:41

希望添加一个选项可以解决此问题:
(vl-load-com)
 
~'J'~

Bane 发表于 2022-7-6 17:57:15

我已经试过类似的东西了。在我当前的图形中,有两个点必须在选择集中选择,因为它们代表两条线的起点。但当我启动这段代码时,它们并没有被选中。只有我放大到足够清楚地看到这两点,一切都好。
 
可能需要注意的是,第三条线非常靠近该点(约2mm)。
 
如果你愿意,我可以举个例子。
 
谢谢
 

fixo 发表于 2022-7-6 18:09:04

我认为您需要在之前将OSMODE设置为0
在这些点上画圆
好的,上传你的画看看在哪里
一个问题
 
~'J'~

Bane 发表于 2022-7-6 18:11:53

Autocad有一个坏习惯,即在使用lisp时捕捉错误的对象等。通常最好将osmode设置为0,并在代码结束时重置它(setvar“osmode”myosmode)。
 
还有一个bug,我遇到了类似的问题,为了使lisp正常工作,我必须放大到一个合理的观看比例,很好,太远是不行的!使用第一个拾取,然后在下一个拾取点之前缩放比例。

fixo 发表于 2022-7-6 18:18:11

这是另一种方法,虽然没有那么快。
(defun find points(/en i pt result ssl ssp EndPoints TmpLst1 TmpLst2)(vl load com)(setq ssp(ssget“_X”(list(cons 0”POINT))(cons 410(getvar“CTAB”)))(setq ssl(ssget“_X”(list(cons 0”LINE,*POLYLINE))(cons 410(getvar“CTAB”))   )         ) ) ;;从直线和多段线(setq i-1)获取所有端点(while(setq en(ssname ssl(setq i(1+i))))(setq端点(cons(vlax curve getstartpoint en)端点)端点(cons(vlax curve getendpoint en)端点));;循环通过所有点,查找任何匹配的端点(setq i-1)(while(setq en(ssname ssp(setq i(1+i)))(setq pt(cdr(assoc 10(entget en))))(setq TmpLst1端点TmpLst2 nil)(while;通过所有线路端点循环,删除任何匹配(和端点(setq p(car TmpLst1))(if(equal(distance pt p)0.0.00001)(progn;获得匹配点(setq结果(cons en结果));将点收集到列表(setq端点(append(反向TmpLst2)(cdr TmpLst1)))nil;退出While Loop)(setq TmpLst2(cons p TmpLst2)TmpLst1(cdr TmpLst1));不匹配,保持循环)结果;

BIGAL 发表于 2022-7-6 18:23:34

CAB 发表于 2022-7-6 18:32:57

Here is another method, not as fast though.

(defun find-points (/ en i pt result ssl ssp EndPoints TmpLst1 TmpLst2) (vl-load-com) (setq ssp (ssget "_X"                  (list                  (cons 0 "POINT")                  (cons 410 (getvar "CTAB"))                  )         ) ) (setq ssl (ssget "_X"                  (list                  (cons 0 "LINE,*POLYLINE")                  (cons 410 (getvar "CTAB"))                  )         ) ) ;;get all endpoints from Lines & Polylines (setq i -1) (while (setq en (ssname ssl (setq i (1+ i))))   (setq EndPoints (cons (vlax-curve-getstartpoint en) EndPoints)         EndPoints (cons (vlax-curve-getendpoint en) EndPoints)   ) ) ;;Loop through All points, find any matching end points (setq i -1) (while (setq en (ssname ssp (setq i (1+ i))))   (setq pt (cdr (assoc 10 (entget en))))   (setq TmpLst1 EndPoints         TmpLst2 nil   )   (While ; loop through All Line endpoints, remove any matches   (and EndPoints          (setq p (car TmpLst1))          (if (equal (distance pt p) 0.0 0.00001)            (progn ; got a matching point            (setq result (cons en result)) ; gather points into a list            (setq Endpoints (append (reverse TmpLst2) (cdr TmpLst1)))            nil ; Exit While Loop            )            (setq TmpLst2 (cons p TmpLst2)                  TmpLst1 (cdr TmpLst1)) ; not a match, stay in loop          )   )   ) ) result   ;
页: [1]
查看完整版本: 查找与lin连接的点