664571221 发表于 2023-4-26 21:45:33

各位大神,求两个图层的线的交点形成圆

各位大神,求两个图层的线的交点形成圆,输入tt,提示选择第一个图层,然后提示选择第二个图层,然后选择图纸范围,范围内的图层一和图层二的线的交点形成圆形

x_s_s_1 发表于 2023-5-2 11:38:08

(defun c:tt(/ en en1 en2 int lst1 lst2 n pt space ss)
(setqen1   (car (entsel "\n图层1"))
en2   (car (entsel "\n图层2"))
ss    (ssget "w"
         (setq pt (getpoint "\n窗口第一点:"))
         (getcorner pt "\n窗口第二点:")
         (list '(-4 . "<or")
         (setq en1 (assoc 8 (entget en1)))
         (setq en2 (assoc 8 (entget en2)))
         '(-4 . "or>")))
space (vlax-get-property
    (vlax-get-property
      (vlax-get-acad-object)
      "activedocument")
    "ModelSpace"))
(repeat (setq n (sslength ss))
    (setq en (ssname ss (setq n (1- n))))
    (if(equal en1 (assoc 8 (entget en)))
      (setq lst1 (cons (vlax-ename->vla-object en) lst1))
      (setq lst2 (cons (vlax-ename->vla-object en) lst2))))
(while lst1
    (setq en1(car lst1)
    lst1 (cdr lst1))
    (foreach nlst2
      (if (null(vl-catch-all-error-p
      (setqint (vl-catch-all-apply
            'vlax-safearray->list
            (list (vlax-variant-value
            (vlax-invoke-method
          en1
          "intersectwith"
          n
          acextendnone)))))))
(while int
    (vlax-invoke-method
      space
      "addcircle"
      (vlax-3d-point (car int) (cadr int) (caddr int))
      50)
    (setq int (cdddr int)))))))我也来凑个热闹,极不严谨的代码:lol

vitalgg 发表于 2023-4-26 23:09:45

本帖最后由 vitalgg 于 2023-4-26 23:11 编辑

(defun c:tt ()
(setq lay1 (entity:getdxf(car (entsel (@:speak"请点选第一个图层上的图形:"))) 8))
(setq lay2 (entity:getdxf(car (entsel (@:speak"请点选第二个图层上的图形:"))) 8))
(setq pt2 (getcorner (setq pt1(getpoint (@:speak"矩形第一角点:")))(@:speak"矩形第二角点:")))
(setq ents1 (pickset:to-list(ssget "w" pt1 pt2(list (cons 0 (@:get-config '@curve:types))(cons 8 lay1)))))
(setq ents2 (pickset:to-list(ssget "w" pt1 pt2(list (cons 0 (@:get-config '@curve:types))(cons 8 lay2)))))
(setq res nil)
(foreach ent1 ents1
    (foreach ent2 ents2
      (setq res (append res
                  (curve:inters ent1 ent2 acextendnone)
      ))))
(entity:make-circle
    (vl-remove nil res)
    50
))


https://atlisp.cn/static/videos/2layer-cross.mp4

zhaoxt 发表于 2023-5-2 07:10:48

本帖最后由 zhaoxt 于 2023-5-2 07:15 编辑

稍微提点小意见。提问了问题有人解答,还是要表示下感谢的。我一开始以为你没登陆网站,但后来却看到你昨天还极有耐心的翻出了2008年的一个老帖,还在问人家要代码当然,这也可能只是是你疏忽忘记了 ,我想说的是,这个论坛对初学LISP的人真的很有用,都这样的话大家回复的热情就越来越少,能想象一下只有新手提问却无人回答的场面吗。。。。。。。。。。。。

664571221 发表于 2023-5-2 09:16:49

zhaoxt 发表于 2023-5-2 07:10
稍微提点小意见。提问了问题有人解答,还是要表示下感谢的。我一开始以为你没登陆网站,但后来却看到你昨天 ...

我了楼上那位已经再qq上深入交流了,谢谢你提的意见,我混迹论坛十几年,基本都是熟人了

664571221 发表于 2023-5-2 09:24:44

zhaoxt 发表于 2023-5-2 07:10
稍微提点小意见。提问了问题有人解答,还是要表示下感谢的。我一开始以为你没登陆网站,但后来却看到你昨天 ...

谢谢你啊,你也是一位非常热心的人

664571221 发表于 2023-5-2 11:44:31

x_s_s_1 发表于 2023-5-2 11:38
我也来凑个热闹,极不严谨的代码

大佬你可以更加严谨点:lol

橡皮 发表于 2023-5-2 12:00:27

x_s_s_1 发表于 2023-5-2 11:38
我也来凑个热闹,极不严谨的代码

大家是真谦虚啊

jkop 发表于 2023-5-25 09:31:23

感谢大神提供源码供我辈学习。

664571221 发表于 2023-5-25 16:31:15

jkop 发表于 2023-5-25 09:31
感谢大神提供源码供我辈学习。

期待你变大神.....
页: [1]
查看完整版本: 各位大神,求两个图层的线的交点形成圆