社区 › Auto Lisp › 快速检查

giskumar 发表于 2022-7-6 10:12:34

快速检查

大家好
 
我想对多段线数据进行快速检查。
我通过使用ssget“\u cp”选择多段线两端的实体来实现这一点
选项为此，我必须将屏幕缩放到每一行的末尾，以进行选择，这将花费很多时间。
 
是否有一个过程可以使用ssget检查快照错误而不必退出。
 
 
谢谢
库马尔。

JohnM 发表于 2022-7-6 10:20:05

你说的捕捉错误是什么意思？

BlackBox 发表于 2022-7-6 10:21:16

查看开发人员文档中的vlax curve getStartPoint和vlax curve getEndPoint函数。
 
***它们都将接受ENAME而不是vla对象。

giskumar 发表于 2022-7-6 10:26:44

我希望确保所有多段线在其端点处相互捕捉。在Autocad map版本中，我们可以通过使用拓扑检查来确保。但现在我有一个在Intelli cad上的情况，在这种情况下没有可用的地图命令。
 
因此，我想制作一个lisp例程，不使用visual lisp函数检查端点处的多段线捕捉。如果一端未捕捉到另一端，则需要标记错误。
 
谢谢
库马尔。

BlackBox 发表于 2022-7-6 10:28:50

 
 
放弃Visual LISP的原因是什么？

ReMark 发表于 2022-7-6 10:34:08

为什么这两条线不互相对齐？你是否故意“盯着”线路之间的连接（顺便说一句，实践不佳）？

JohnM 发表于 2022-7-6 10:35:10

如果只是检查2条多段线，请使用ssget _cp，然后获取每个实体并列出顶点，然后比较两个列表的第一个和最后一个顶点
如果选择两个以上，则会出现问题，因为ssget cp可能不会返回正确的顺序，因此可以使用ssadd，然后通过顶点检查进行解析，然后

BlackBox 发表于 2022-7-6 10:40:19

也许这将提供一个起点：
 

(defun c:FOO(/ ss)
(vl-load-com)
(if (setq ss (ssget '((0 . "LINE,*POLYLINE"))))
   ((lambda (i / e l)
      (while (setq e (ssname ss (setq i (1+ i))))
      (setq l
               (cons
               (cons e
                     (list
                         (vlax-curve-getstartpoint e)
                         (vlax-curve-getendpoint e)))
               l)))
      (foreach a l
      ;; ... Rest of code goes here
      ))
   -1))
(princ))

David Bethel 发表于 2022-7-6 10:44:15

对于线路，来自John Uhden

;;-----------------------------------------------
;; SSGETENDS.LSP (c)2002, John F. Uhden, Cadlantic
;; Function to create a selection set of Lines
;; within a fuzz distance of either end of a Line
;; given the 'ENAME of the selected line and the
;; fuzz distance as a real or integer.
;; Dedicated to Bill Zondlo c.02-04-02
;;
(defun ssgetends (e fuzz / ent p10 p11 ss)
(and
   (= (type e) 'ENAME)
   (numberp fuzz)
   (>= fuzz 0)
   (setq ent (entget e))
   (= (cdr (assoc 0 ent)) "LINE")
   (setq p10 (cdr (assoc 10 ent)))
   (setq p11 (cdr (assoc 11 ent)))
   (setq fuzz (list fuzz fuzz fuzz))
   (setq ss
   (ssget "X"
       (list
      '(0 . "LINE")
      '(-4 . "<OR")
          '(-4 . "<AND")
            '(-4 . ">=,>=,>=")
             (cons 10 (mapcar '- p10 fuzz))
            '(-4 . "<=,<=,<=")
             (cons 10 (mapcar '+ p10 fuzz))
          '(-4 . "AND>")
          '(-4 . "<AND")
            '(-4 . ">=,>=,>=")
             (cons 10 (mapcar '- p11 fuzz))
            '(-4 . "<=,<=,<=")
             (cons 10 (mapcar '+ p11 fuzz))
          '(-4 . "AND>")
          '(-4 . "<AND")
            '(-4 . ">=,>=,>=")
             (cons 11 (mapcar '- p10 fuzz))
            '(-4 . "<=,<=,<=")
             (cons 11 (mapcar '+ p10 fuzz))
          '(-4 . "AND>")
          '(-4 . "<AND")
            '(-4 . ">=,>=,>=")
             (cons 11 (mapcar '- p11 fuzz))
            '(-4 . "<=,<=,<=")
             (cons 11 (mapcar '+ p11 fuzz))
          '(-4 . "AND>")
      '(-4 . "OR>")
       )
   )

JohnM 发表于 2022-7-6 10:48:59

代码不错David，
 
这就是我所期待的。
 
我正在处理多段线，因此我将代码更改如下。
 
(defun c:SN (/ e1 e2)
(if (and (setq e1 (entsel "\nSelect first object: "))
          (setq e2 (entsel "\nSelect second object: "))
   )
   (if (apply (function (lambda (a b) (equal a b 0.)))
            (mapcar (function (lambda (e)
                                  (cond ((osnap (cadr e) "_END"))
                                        ((cdr (assoc 10 (entget (car e)))))
                                  )
                              )
                      )
                      (list e1 e2)
            )
       )
   (alert "Objects snap.")
   (alert "Objects do not snap!")
   )
)
(princ)
)
 
感谢大家分享想法。。。。。
 
库马尔。

查看完整版本: 快速检查