社区 › Auto Lisp › 请帮助：）Lisp检测

digitalmapper 发表于 2022-7-5 16:53:38

请帮助：）Lisp检测

大家好。我一直在试图找到一个lisp，它可以检测指定图层的多段线是否位于另一个指定图层的多段线内。
 
我想检查图层（图层1、图层2和图层3….）下的闭合多段线是否正确位于第4层下的闭合多段线内。
 
我希望有人明白我说的话。我在AutoCAD中所能做的最好的事情就是创建宏，而这是无法做到的

Tharwat 发表于 2022-7-5 17:10:39

你好
 
确保在屏幕上完全看到选定多段线的边界，否则程序可能会失败或无法检测到所有多段线对象。

(defun c:test (/ sn ss dis div s in l)
(princ "\nPick a closed polyline :")
(if (setq s (ssget "_+.:S:E" '((0 . "*POLYLINE") (8 . "Layer4") (-4 . "&=") (70 . 1))))
   (progn
   (setq sn(ssname s 0)
         dis (/ (vlax-curve-getdistatparam
                  sn
                  (fix (vlax-curve-getendparam sn))
                  )
                  100.
               )
         div dis
   )
   (repeat 100
       (setq l (cons (vlax-curve-getpointatdist sn dis) l))
       (setq dis (+ div dis))
   )
   (if (setq
         ss (ssget "_WP"
                     l
                     '((0 . "*POLYLINE") (8 . "Layer1,Layer2,Layer3"))
            )
         )
       (sssetfirst nil ss)
   )
   )
)
(princ)
)

digitalmapper 发表于 2022-7-5 17:12:43

那是法斯特·塔瓦特。
 
虽然程序很好，但如果第1层、第2层或第3层下的任何多段线不完全在第4层内，是否可能提示错误消息？

Tharwat 发表于 2022-7-5 17:24:42

 
试试这个：

(defun c:test (/ lays fnd sn ss dis div s lst lay l)
;; Tharwat - 07.Dec.2016 ;;
(princ "\nPick on closed polyline :")
(if (setq lays "Layer1,Layer2,Layer3"
         fnd0
         s    (ssget "_+.:S:E"
                     '((0 . "*POLYLINE") (8 . "Layer4") (-4 . "&=") (70 . 1))
                )
   )
   (progn
   (setq sn(ssname s 0)
         dis (/ (vlax-curve-getdistatparam
                  sn
                  (fix (vlax-curve-getendparam sn))
                  )
                  100.
               )
         div dis
   )
   (repeat 100
       (setq l (cons (vlax-curve-getpointatdist sn dis) l))
       (setq dis (+ div dis))
   )
   (if (setq
         ss (ssget "_WP" l (list '(0 . "*POLYLINE") (cons 8 lays)))
         )
       (while (and (/= fnd 3)
                   (setq sn (ssname ss 0))
            )
         (and (wcmatch (setq lay (cdr (assoc 8 (entget sn)))) lays)
            (not (member lay lst))
            (setq lst (cons lay lst))
            (setq fnd (length lst))
         )
         (ssdel sn ss)
       )
   )
   (cond
       ((= fnd 3) (princ "\nAll layers are found "))
       ((>= fnd 1)
      (princ
          (strcat
            "\nPolylines' layers ["
            (vl-string-right-trim
            ","
            (apply 'strcat (mapcar '(lambda (u) (strcat u ",")) lst))
            )
            "]."
          )
      )
       )
       ((princ "\nNo polylines found on specified layers <!>"))
   )
   )
)
(princ)
)(vl-load-com)

digitalmapper 发表于 2022-7-5 17:30:46

效果很好！非常感谢。
 
一个简单的问题是，我如何将“选择对象：”更改为“选择对象：”因为我将只选择一个对象

Grrr 发表于 2022-7-5 17:42:09

 
使用entsel/entsel代替ssget，并修改一半代码。

Roy_043 发表于 2022-7-5 17:49:14

显然，有一种方法可以抑制默认的ssget提示（但我认为它在BricsCAD中效果不好）。

(prompt ...)
(setvar 'nomutt 1)
(ssget ...)
(setvar 'nomutt 0)

digitalmapper 发表于 2022-7-5 17:58:26

我还有一个问题，当（Layer1，Layer2，Layer3）下的一条或多条多段线位于Layer4之上时，我希望将其视为在多段线内。如果它在外面，它只会将其排除在外。

查看完整版本: 请帮助：）Lisp检测