矩形交叉需要lisp

git_thailand · 发表于 2022-7-6 08:46:52

代码1=使矩形在内部交叉（x）（不同层）
代码2=通过多选矩形使（+）穿过中心线并删除。

paulmcz · 发表于 2022-7-6 08:55:50

代码1：

(defun c:cr (/         lt  ename   b         c   sn         sn1 sn2 p1  p2         p3  p4         f
     d         d1  d2         d3  a1         a2  a3         a4  p5         p6  p7         p8  p9         p10
     sc ocl la
    )
 (command "cmdecho" (getvar "cmdecho"))
 (setq lt "center")
 (if (= (tblsearch "ltype" lt) nil)
   (command "-linetype" "l" lt "acad.lin" "")
 )
 (setq        ocl   (getvar "clayer"))
 (setq la "different")
 (if (tblsearch "layer" la)
   (command "-layer" "s" la "")
   (command "-layer" "m" la "")
 )
 
 (princ "\n Select rectangles: ")
 (setq        ss  (ssget '((-4 . "<and")
             (0 . "LWPOLYLINE")
             (70 . 1)
             (90 . 4)
             (-4 . "and>")
            )
    )
sn  (sslength ss)
sn1 sn
 )
 (repeat sn
   (setq sn2        (1- sn1)
  ename        (ssname ss sn2)
  b        (entget ename)
  b        (member (assoc 10 b) b)
   )
   (while (member (assoc 10 b) b)
     (setq c (append c (list (cdr (assoc 10 b))))
    b (cdr b)
    b (member (assoc 10 b) b)
     )
   )
   (setq f   0.125
  d   0.12
  p1  (nth 0 c)
  p2  (nth 1 c)
  p3  (nth 2 c)
  p4  (nth 3 c)
  c   nil
  d1  (/ (distance p1 p2) 2)
  d2  (/ (distance p2 p3) 2)
  d3  (if (> d1 d2)
        (* d1 0.12)
        (* d2 0.12)
      )
  a1  (angle p1 p2)
  a2  (angle p2 p1)
  a3  (angle p2 p3)
  a4  (angle p3 p2)
  p5  (polar p1 a1 d1)
  p6  (polar p5 a4 d3)
  p7  (polar p6 a3 (+ (* d2 2) (* d3 2)))
  p8  (polar p2 a3 d2)
  p9  (polar p8 a1 d3)
  p10 (polar p9 a2 (+ (* d1 2) (* d3 2)))
  sc  (* (+ d1 d2) f)
  sn1 sn2
   )
   (entmake (list
       (cons 0 "LINE")
       (cons 8 la)
       (cons 6 lt)
       (cons 62 3)
       (cons 10 p6)
       (cons 11 p7)
       (cons 48 sc)
       (cons 210 (list 0.0 0.0 1.0))
     )
   )
   (entmake (list
       (cons 0 "LINE")
       (cons 8 la)
       (cons 6 lt)
       (cons 62 3)
       (cons 10 p9)
       (cons 11 p10)
       (cons 48 sc)
       (cons 210 (list 0.0 0.0 1.0))
     )
   )
 )
 (setvar "clayer" ocl)
 (princ)
)

对于代码2，删除什么？矩形？

git_thailand · 发表于 2022-7-6 08:59:48

代码1=x cross no+cross（在0层中设置矩形，在1层中设置x cross）代码2=代码1您，但我想在多选矩形中的cont line（无中心线线型）中创建cross line并删除rec

paulmcz · 发表于 2022-7-6 09:07:20

给你（代码1=>cr，代码2=>crd）。

copy

(defun c:cr (/         lt  ename   b         c   sn         sn1 sn2 p1  p2         p3  p4         f
     d         d1  d2         d3  a1         a2  a3         a4  p5         p6  p7         p8  p9         p10
     sc ocl la ent lar
    )
 (command "cmdecho" (getvar "cmdecho"))
 (setq lt "center")
 (if (= (tblsearch "ltype" lt) nil)
   (command "-linetype" "l" lt "acad.lin" "")
 )
 (setq        ocl   (getvar "clayer"))
 (setq la "1"
lar "0")
 (if (tblsearch "layer" la)
   (command "-layer" "s" la "")
   (command "-layer" "m" la "")
 )
 
 (princ "\n Select rectangles: ")
 (setq        ss  (ssget '((-4 . "<and")
             (0 . "LWPOLYLINE")
             (70 . 1)
             (90 . 4)
             (-4 . "and>")
            )
    )
sn  (sslength ss)
sn1 sn
 )
 (repeat sn
   (setq sn2        (1- sn1)
  ename        (ssname ss sn2)
  ent        (entget ename)
  b        (member (assoc 10 ent) ent)
   )
   (while (member (assoc 10 b) b)
     (setq c (append c (list (cdr (assoc 10 b))))
    b (cdr b)
    b (member (assoc 10 b) b)
     )
   )
   (setq f   0.125
  d   0.12
  p1  (nth 0 c)
  p2  (nth 1 c)
  p3  (nth 2 c)
  p4  (nth 3 c)
  c   nil
  d1  (/ (distance p1 p2) 2)
  d2  (/ (distance p2 p3) 2)
  d3  (if (> d1 d2)
        (* d1 0.12)
        (* d2 0.12)
      )
  a1  (angle p1 p2)
  a2  (angle p2 p1)
  a3  (angle p2 p3)
  a4  (angle p3 p2)
  p5  (polar p1 a1 d1)
  p6  (polar p5 a4 d3)
  p7  (polar p6 a3 (+ (* d2 2) (* d3 2)))
  p8  (polar p2 a3 d2)
  p9  (polar p8 a1 d3)
  p10 (polar p9 a2 (+ (* d1 2) (* d3 2)))
  sc  (* (+ d1 d2) f)
  sn1 sn2
   )
   (entmake (list
       (cons 0 "LINE")
       (cons 8 la)
       (cons 6 lt)
       ;(cons 62 3)
       (cons 10 p1)
       (cons 11 p3)
       (cons 48 sc)
       (cons 210 (list 0.0 0.0 1.0))
     )
   )
   (entmake (list
       (cons 0 "LINE")
       (cons 8 la)
       (cons 6 lt)
       ;(cons 62 3)
       (cons 10 p2)
       (cons 11 p4)
       (cons 48 sc)
       (cons 210 (list 0.0 0.0 1.0))
     )
   )
   (if (= "0" (cdr (assoc 8 ent)))
     ()
     (progn
       (setq ent (subst (cons 8 lar) (assoc 8 ent) ent))
       (entmod ent)
     )
   )
 )
 (setvar "clayer" ocl)
 (princ)
)
(defun c:crd (/         lt  ename   b         c   sn         sn1 sn2 p1  p2         p3  p4         f
     d         d1  d2         d3  a1         a2  a3         a4  p5         p6  p7         p8  p9         p10
     sc ocl la ent
    )
 (command "cmdecho" (getvar "cmdecho"))
 (setq lt "center")
 (if (= (tblsearch "ltype" lt) nil)
   (command "-linetype" "l" lt "acad.lin" "")
 )
 (setq        ocl   (getvar "clayer"))
 (setq la "1")
 (if (tblsearch "layer" la)
   (command "-layer" "s" la "")
   (command "-layer" "m" la "")
 )
 
 (princ "\n Select rectangles: ")
 (setq        ss  (ssget '((-4 . "<and")
             (0 . "LWPOLYLINE")
             (70 . 1)
             (90 . 4)
             (-4 . "and>")
            )
    )
sn  (sslength ss)
sn1 sn
 )
 (repeat sn
   (setq sn2        (1- sn1)
  ename        (ssname ss sn2)
  ent        (entget ename)
  b        (member (assoc 10 ent) ent)
   )
   (while (member (assoc 10 b) b)
     (setq c (append c (list (cdr (assoc 10 b))))
    b (cdr b)
    b (member (assoc 10 b) b)
     )
   )
   (setq f   0.125
  d   0.12
  p1  (nth 0 c)
  p2  (nth 1 c)
  p3  (nth 2 c)
  p4  (nth 3 c)
  c   nil
  d1  (/ (distance p1 p2) 2)
  d2  (/ (distance p2 p3) 2)
  d3  (if (> d1 d2)
        (* d1 0.12)
        (* d2 0.12)
      )
  a1  (angle p1 p2)
  a2  (angle p2 p1)
  a3  (angle p2 p3)
  a4  (angle p3 p2)
  p5  (polar p1 a1 d1)
  p6  (polar p5 a4 d3)
  p7  (polar p6 a3 (+ (* d2 2) (* d3 2)))
  p8  (polar p2 a3 d2)
  p9  (polar p8 a1 d3)
  p10 (polar p9 a2 (+ (* d1 2) (* d3 2)))
  sc  (* (+ d1 d2) f)
  sn1 sn2
   )
   (entmake (list
       (cons 0 "LINE")
       (cons 8 la)
       ;(cons 6 lt)
       ;(cons 62 3)
       (cons 10 p6)
       (cons 11 p7)
       ;(cons 48 sc)
       (cons 210 (list 0.0 0.0 1.0))
     )
   )
   (entmake (list
       (cons 0 "LINE")
       (cons 8 la)
       ;(cons 6 lt)
       ;(cons 62 3)
       (cons 10 p9)
       (cons 11 p10)
       ;(cons 48 sc)
       (cons 210 (list 0.0 0.0 1.0))
     )
   )
 (entdel ename)
 )
 (setvar "clayer" ocl)
 (princ)
)

git_thailand · 发表于 2022-7-6 09:11:15

谢谢你。
paulmcz plese make code=创建rec和xcross

paulmcz · 发表于 2022-7-6 09:17:54

由于您没有清楚地描述您想要（或需要）的内容，我或其他人可能会连续几天编写代码，这对您来说仍然不够好。我认为现在是你开始学习如何编写自己的代码的好时机。从一开始，你现在想要的应该很容易学会。

从这里开始。如果你陷入困境，在这里问你的问题，我或其他人会帮助你。如果你不打算清楚而详细地表达你的问题，不要指望有人会读懂你的心思。看看这里如何发帖子，这样你就有机会得到一些答案。此外，请参见AutoCAD的vlide部分中的帮助文件（在命令行上键入vlide并转到“帮助”菜单）。

祝你好运

pBe · 发表于 2022-7-6 09:24:30

同上

相信我。Autolisp并不难学。

ILoveMadoka · 发表于 2022-7-6 09:30:13

编写基本的Autolisp并没有那么难，但我仍然对这里的人编写的代码感到惊讶。。。
我仍然是新手（尤其是在这里的许多人中），但这里有很多代码甚至
试图分析某个特定程序中发生的事情超出了我的理解范围。

虽然至少需要学习一些基础知识是有道理的
我们大多数人不会告诉别人，学会自己修车或
学会自己做水管，学会自己做木工活
或板岩或电气工程。
如果你知道怎么做，这些事情都不难。。。
没有人超越了“学习能力”。。。

在寻求帮助之前，我会想办法解决问题，但很多应用程序
对我们大多数人来说是相当先进的。
我确实意识到“我需要帮助”和
“我需要有人为我编写一个特定的程序。”

我不是唯一一个同时做到这两件事的人。。

请宽恕我们这些知识较少的人，否则我们会害怕寻求帮助。。。

Lee Mac · 发表于 2022-7-6 09:37:59

但我们大多数人也会付钱给别人帮我们做这些事情，而不是免费的。。。

不是恨，只是说。

ILoveMadoka · 发表于 2022-7-6 09:46:22

说得好。。。

我知道当我提出请求时，我并没有“期待”任何东西。
我“希望并祈祷”有人会怜悯我！

让我想起我第一次买卡车的时候。。。。
每个周末我好像都会接到一个电话

“这个周末你在做什么？”

我们中的一些人只是没有达到高级编程的能力。
我渴望它，但我几乎没有通过代数，也没有很好的逻辑头脑。。。

我经常来这里是因为那些比我了解更多的人的慷慨。

一、首先，我永远感谢您和其他人通过该网站提供的所有帮助！

=^.^=

[编程交流] 矩形交叉需要lisp

发表回复

精选推荐