求一个 两点中心线 小程序

229096767

不知道是不是如图所示:

2. (defun c:tt()
   
3.   (prompt "\n请选择两条直线:")
   
4.   (setq ss (ssget))
   
5.   (if (>= (sslength ss) 2)
   
6.     (progn
   
7.       (setq ent1 (entget (ssname ss 0)))
   
8.       (setq ent2 (entget (ssname ss 1)))
   
9.       
   
10.       (setq pt11 (cdr (assoc 10 ent1)))
    
11.       (setq pt12 (cdr (assoc 11 ent1)))
    
12.       
    
13.       (setq pt21 (cdr (assoc 10 ent2)))
    
14.       (setq pt22 (cdr (assoc 11 ent2)))
    
15.       
    
16.       (setq pt13 (mapcar '(lambda(x y)(/ (+ x y) 2.0)) pt11 pt12));中点
    
17.       (setq pt23 (mapcar '(lambda(x y)(/ (+ x y) 2.0)) pt21 pt22));中点
    
18.       
    
19.       (command "line" pt13 pt23 "");中点连线
    
20.       
    
21.       (setq pt33 (mapcar '(lambda(x y)(/ (+ x y) 2.0)) pt13 pt23));中点连线的中点
    
22.       (setq ang1 (angle pt13 pt23));中点连线的角度
    
23.       
    
24.       (setq L (/ (distance pt13 pt23) 2.0))
    
25.       
    
26.       (setq pt31 (polar pt33 (- ang1 (/ pi 2)) L))
    
27.       (command "line" pt33 pt31 "")
    
28.       
    
29.       (setq pt32 (polar pt33 (+ ang1 (/ pi 2)) L))
    
30.       (command "line" pt33 pt32 "")
    
31.       
    
32.     )
    
33.   )
    
34. )

(defun c:tt()<br />   (prompt "\n请选择两条直线:")<br />   (setq ss (ssget))<br />   (if (>= (sslength ss) 2)<br />     (progn<br />       (setq ent1 (entget (ssname ss 0)))<br />       (setq ent2 (entget (ssname ss 1)))<br />       <br />       (setq pt11 (cdr (assoc 10 ent1)))<br />       (setq pt12 (cdr (assoc 11 ent1)))<br />       <br />       (setq pt21 (cdr (assoc 10 ent2)))<br />       (setq pt22 (cdr (assoc 11 ent2)))<br />       <br />       (setq pt13 (mapcar '(lambda(x y)(/ (+ x y) 2.0)) pt11 pt12));中点<br />       (setq pt23 (mapcar '(lambda(x y)(/ (+ x y) 2.0)) pt21 pt22));中点<br />       <br />       (command "line" pt13 pt23 "");中点连线<br />       <br />       (setq pt33 (mapcar '(lambda(x y)(/ (+ x y) 2.0)) pt13 pt23));中点连线的中点<br />       (setq ang1 (angle pt13 pt23));中点连线的角度<br />       <br />       (setq L (/ (distance pt13 pt23) 2.0))<br />       <br />       (setq pt31 (polar pt33 (- ang1 (/ pi 2)) L))<br />       (command "line" pt33 pt31 "")<br />       <br />       (setq pt32 (polar pt33 (+ ang1 (/ pi 2)) L))<br />       (command "line" pt33 pt32 "")<br />       <br />     )<br />   )<br /> )

king、

229096767 发表于 2022-10-14 14:26
不知道是不是如图所示:

可能我表述不清楚，图片现在应该清晰些

xj6019

感觉坑有点深！

king、

xj6019 发表于 2022-10-14 15:49
感觉坑有点深！

还好吧，只是想点两个点生成一个十字线

229096767

king、 发表于 2022-10-14 15:28
可能我表述不清楚，图片现在应该清晰些

2. (defun c:tt()
   
3.   (prompt "\n请选择两条直线:")
   
4.   (setq ss (ssget))
   
5.   (if (>= (sslength ss) 2)
   
6.     (progn
   
7.       (setq ent1 (entget (ssname ss 0)))
   
8.       (setq ent2 (entget (ssname ss 1)))
   
9.       
   
10.       (setq pt11 (cdr (assoc 10 ent1)))
    
11.       (setq pt12 (cdr (assoc 11 ent1)))
    
12.       
    
13.       (setq pt21 (cdr (assoc 10 ent2)))
    
14.       (setq pt22 (cdr (assoc 11 ent2)))
    
15.       
    
16.       (setq pt13 (mapcar '(lambda(x y)(/ (+ x y) 2.0)) pt11 pt12));中点
    
17.       (setq pt23 (mapcar '(lambda(x y)(/ (+ x y) 2.0)) pt21 pt22));中点
    
18.       
    
19.       
    
20.       (setq pt31 (list (car pt23) (cadr pt13)))
    
21.       (setq pt32 (list (car pt13) (cadr pt23)))
    
22.       
    
23.       (setq H 100)
    
24.       
    
25.       (setq ang1 (angle pt13 pt31))
    
26.       (setq pt41 (polar pt31 ang1 (- H)))
    
27.       (setq pt42 (polar pt31 ang1 H))
    
28.       
    
29.       (entmake (list '(0 . "LINE") '(62 . 1) (cons 10 pt41) (cons 11 pt42)))
    
30.       
    
31.       (setq ang2 (angle pt23 pt31))
    
32.       (setq pt51 (polar pt31 ang2 (- H)))
    
33.       (setq pt52 (polar pt31 ang2 H))
    
34.       
    
35.       (entmake (list '(0 . "LINE") '(62 . 1) (cons 10 pt51) (cons 11 pt52)))
    
36. 
    
37.     )
    
38.   )
    
39. )

(defun c:tt()<br />   (prompt "\n请选择两条直线:")<br />   (setq ss (ssget))<br />   (if (>= (sslength ss) 2)<br />     (progn<br />       (setq ent1 (entget (ssname ss 0)))<br />       (setq ent2 (entget (ssname ss 1)))<br />       <br />       (setq pt11 (cdr (assoc 10 ent1)))<br />       (setq pt12 (cdr (assoc 11 ent1)))<br />       <br />       (setq pt21 (cdr (assoc 10 ent2)))<br />       (setq pt22 (cdr (assoc 11 ent2)))<br />       <br />       (setq pt13 (mapcar '(lambda(x y)(/ (+ x y) 2.0)) pt11 pt12));中点<br />       (setq pt23 (mapcar '(lambda(x y)(/ (+ x y) 2.0)) pt21 pt22));中点<br />       <br />       <br />       (setq pt31 (list (car pt23) (cadr pt13)))<br />       (setq pt32 (list (car pt13) (cadr pt23)))<br />       <br />       (setq H 100)<br />       <br />       (setq ang1 (angle pt13 pt31))<br />       (setq pt41 (polar pt31 ang1 (- H)))<br />       (setq pt42 (polar pt31 ang1 H))<br />       <br />       (entmake (list '(0 . "LINE") '(62 . 1) (cons 10 pt41) (cons 11 pt42)))<br />       <br />       (setq ang2 (angle pt23 pt31))<br />       (setq pt51 (polar pt31 ang2 (- H)))<br />       (setq pt52 (polar pt31 ang2 H))<br />       <br />       (entmake (list '(0 . "LINE") '(62 . 1) (cons 10 pt51) (cons 11 pt52)))<br /> <br />     )<br />   )<br /> )

飞的鱼儿

(defun c:jjbb()
  (setq p1 (getpoint"\n线A左端点")
        p2 (getpoint"\n线A右端点")
        p3 (getpoint"\n线B左端点")
        p4 (getpoint"\n线B右端点")

        )
  (setq x1 (/ (+ (car p1) (car p2))2)
        x2 (/ (+ (car p3) (car p4))2)
        )
  (setq y1 (cadr p1)
        y2 (cadr p3)
        )
  (setq x100 (max x1 x2)
        y100 (min y1 y2)
        )
  (setq os1 (getvar "osmode"))
  (setvar "osmode" 0)
  (10zz (list x100 y100) 50)
  )
(defun 10zz (pt1 le1 / p11 p12 p13 p14)
  (setq p11 (polar pt1 (*   0 pi) (*  1 le1))
        p12 (polar pt1 (*   0 pi) (* -1 le1))
        p13 (polar pt1 (* 0.5 pi) (*  1 le1))
        p14 (polar pt1 (* 0.5 pi) (* -1 le1))
        )
  (command"line" p11 p12 "")
  (command"line" p13 p14 "")
  (setvar "osmode" os1)
  )

king、

229096767 发表于 2022-10-14 16:02

非常感谢百忙中帮我些的程序，现在这个程序功能是只能选直线，能否改成用鼠标在两条直线上分别点一下，生成十字线，因为这两个直线有可能是多段线或者面域上的线条

229096767

king、 发表于 2022-10-14 16:21
非常感谢百忙中帮我些的程序，现在这个程序功能是只能选直线，能否改成用鼠标在两条直线上分别 ...

2. (defun c:tt2 (/ h pt1 pt2 pt3 ang1 pt41 pt42 ang2 pt51 pt52)
   
3.   (setq H 100)
   
4.   (setq pt1 (getpoint "\n请选择第一个点:"))
   
5.   (setq pt2 (getpoint pt1 "\n请选择第二个点:"))
   
6. 
   
7.   (setq pt3 (list (car pt2) (cadr pt1)))
   
8. 
   
9.   (setq ang1 (angle pt1 pt3))
   
10.   (setq pt41 (polar pt3 ang1 (- H)))
    
11.   (setq pt42 (polar pt3 ang1 H))
    
12. 
    
13.   (entmake (list '(0 . "LINE") '(62 . 1) (cons 10 pt41) (cons 11 pt42)))
    
14. 
    
15.   (setq ang2 (angle pt2 pt3))
    
16.   (setq pt51 (polar pt3 ang2 (- H)))
    
17.   (setq pt52 (polar pt3 ang2 H))
    
18. 
    
19.   (entmake (list '(0 . "LINE") '(62 . 1) (cons 10 pt51) (cons 11 pt52)))
    
20.   (princ)
    
21. )

(defun c:tt2 (/ h pt1 pt2 pt3 ang1 pt41 pt42 ang2 pt51 pt52)<br />   (setq H 100)<br />   (setq pt1 (getpoint "\n请选择第一个点:"))<br />   (setq pt2 (getpoint pt1 "\n请选择第二个点:"))<br /> <br />   (setq pt3 (list (car pt2) (cadr pt1)))<br /> <br />   (setq ang1 (angle pt1 pt3))<br />   (setq pt41 (polar pt3 ang1 (- H)))<br />   (setq pt42 (polar pt3 ang1 H))<br /> <br />   (entmake (list '(0 . "LINE") '(62 . 1) (cons 10 pt41) (cons 11 pt42)))<br /> <br />   (setq ang2 (angle pt2 pt3))<br />   (setq pt51 (polar pt3 ang2 (- H)))<br />   (setq pt52 (polar pt3 ang2 H))<br /> <br />   (entmake (list '(0 . "LINE") '(62 . 1) (cons 10 pt51) (cons 11 pt52)))<br />   (princ)<br /> )

king、

飞的鱼儿 发表于 2022-10-14 16:20
(defun c:jjbb()
  (setq p1 (getpoint"\n线A左端点")
        p2 (getpoint"\n线A右端点")

  可以用耶，就是鼠标点的多了点

king、

229096767 发表于 2022-10-14 16:28

大佬请收下我的膝盖，此程序正是想要的，非常感谢！