如何修改下面的代码实现柜门线

depgfdepgf

• 
  
  • (defun c:tt1 ( / h lay os p1 p1x p1y p2 p2x p2y)
  •   (setq os (getvar "OSMODE"))
  •   (setvar "cmdecho" 0)
  •   (if (= nil (setq h (getint "\n请输入分格数<4>:")))
  •       (setq h 4)
  •   )
  •   (setq p1 (getpoint "\n指定第一点:"))
  •   (command "rectang" p1 pause)
  •   (setq p2 (getvar "lastpoint")
  •         p1x (car p1)
  •         p1y (cadr p1)
  •         p2x (car p2)
  •         p2y (cadr p2)
  •   )
  •   (setq pt3 (list (+ p1x (/ (- p2x p1x) h)) p2y))
  •   (setq pt2 (list p1x p2y))
  •   (setq pt4 (list (+ p1x (/ (- p2x p1x) h)) p1y))
  •   (setq pa1 (mid_2point p1 pt2))
  •   (setq pa2 (mid_2point pt3 pt4))
  •   (setvar "OSMODE" 0)
  •   (progn
  •       (command "pline" pt3 pa1 pt4 "")
  •       (setq ent1 (entlast))
  •       (command "ARRAY" ent1 "" "R" 1 h (/ (- p2x p1x) h ) )
  •     )
  • (progn
  •       (command "pline" p1 pa2 pt2 "")
  •       (setq ent2 (entlast))
  •       (command "ARRAY" ent2 "" "R" 1 h (/ (- p2x p1x) h ) )
  •     )
  • (progn
  •       (command "line" pt3 pt4 "")
  •       (setq ent3 (entlast))
  •       (command "ARRAY" ent3 "" "R" 1 (1- h) (/ (- p2x p1x) h) )
  •     )
  •   (setvar "OSMODE" os)
  •   (princ)
  • )
  • ;;求两点的中点
  • ;(setq mid_ptA (mid_2point pt1 pt2))
  • (defun mid_2point(e1 e2)
  • (setq mid (mapcar '(lambda (x y) (/ (+ x y) 2))
  •       e1
  •       e2
  •   ))
  • )
  • ;请教各位大佬如何实现这个柜门线，好像用阵列实现不了，但又不知道怎么修改，希望各位大佬出手看下，谢谢！
    

andyding

2. (defun c:tt1 (/ h h1 lay os p1 p1x p1y p2 p2x p2y)
   
3.   (setq os (getvar "OSMODE"))
   
4.   (setvar "cmdecho" 0)
   
5.   (if (= nil (setq h (getint "\n请输入分格数<4>:")))
   
6.     (setq h 4)
   
7.   )
   
8.   (setq h1 (fix (* h 0.5)))
   
9.   (setq p1 (getpoint "\n指定第一点:"))
   
10.   (command "rectang" p1 pause)
    
11.   (setq        p2  (getvar "lastpoint")
    
12.         p1x (car p1)
    
13.         p1y (cadr p1)
    
14.         p2x (car p2)
    
15.         p2y (cadr p2)
    
16.   )
    
17.   (setq pt3 (list (+ p1x (/ (- p2x p1x) h)) p2y))
    
18.   (setq pt2 (list p1x p2y))
    
19.   (setq pt4 (list (+ p1x (/ (- p2x p1x) h)) p1y))
    
20.   (setq pa1 (mid_2point p1 pt2))
    
21.   (setq pa2 (mid_2point pt3 pt4))
    
22.   (setvar "OSMODE" 0)
    
23.   (progn
    
24.     (command "pline" pt3 pa1 pt4 "")
    
25.     (setq ent1 (entlast))
    
26.     (command "mirror" ent1 "" pt3 pt4 "n")
    
27.     (setq entm (entlast))
    
28.     (command "-ARRAY" ent1 entm "" "R" 1 h1 (/ (- p2x p1x) h1))
    
29.   )
    
30. ;;;  (progn
    
31. ;;;    (command "pline" p1 pa2 pt2 "")
    
32. ;;;    (setq ent2 (entlast))
    
33. ;;;    (command "ARRAY" ent2 "" "R" 1 h (/ (- p2x p1x) h))
    
34. ;;;  )
    
35.   (progn
    
36.     (command "line" pt3 pt4 "")
    
37.     (setq ent3 (entlast))
    
38.     (command "ARRAY" ent3 "" "R" 1 (1- h) (/ (- p2x p1x) h))
    
39.   )
    
40.   (setvar "OSMODE" os)
    
41.   (princ)
    
42. )
    
43. ;;求两点的中点
    
44. ;;(setq mid_ptA (mid_2point pt1 pt2))
    
45. (defun mid_2point (e1 e2)
    
46.   (setq        mid (mapcar '(lambda (x y) (/ (+ x y) 2))
    
47.                     e1
    
48.                     e2
    
49.             )
    
50.   )
    
51. )

(defun c:tt1 (/ h h1 lay os p1 p1x p1y p2 p2x p2y)<br />   (setq os (getvar "OSMODE"))<br />   (setvar "cmdecho" 0)<br />   (if (= nil (setq h (getint "\n请输入分格数<4>:")))<br />     (setq h 4)<br />   )<br />   (setq h1 (fix (* h 0.5)))<br />   (setq p1 (getpoint "\n指定第一点:"))<br />   (command "rectang" p1 pause)<br />   (setq        p2  (getvar "lastpoint")<br />         p1x (car p1)<br />         p1y (cadr p1)<br />         p2x (car p2)<br />         p2y (cadr p2)<br />   )<br />   (setq pt3 (list (+ p1x (/ (- p2x p1x) h)) p2y))<br />   (setq pt2 (list p1x p2y))<br />   (setq pt4 (list (+ p1x (/ (- p2x p1x) h)) p1y))<br />   (setq pa1 (mid_2point p1 pt2))<br />   (setq pa2 (mid_2point pt3 pt4))<br />   (setvar "OSMODE" 0)<br />   (progn<br />     (command "pline" pt3 pa1 pt4 "")<br />     (setq ent1 (entlast))<br />     (command "mirror" ent1 "" pt3 pt4 "n")<br />     (setq entm (entlast))<br />     (command "-ARRAY" ent1 entm "" "R" 1 h1 (/ (- p2x p1x) h1))<br />   )<br /> ;;;  (progn<br /> ;;;    (command "pline" p1 pa2 pt2 "")<br /> ;;;    (setq ent2 (entlast))<br /> ;;;    (command "ARRAY" ent2 "" "R" 1 h (/ (- p2x p1x) h))<br /> ;;;  )<br />   (progn<br />     (command "line" pt3 pt4 "")<br />     (setq ent3 (entlast))<br />     (command "ARRAY" ent3 "" "R" 1 (1- h) (/ (- p2x p1x) h))<br />   )<br />   (setvar "OSMODE" os)<br />   (princ)<br /> )<br /> ;;求两点的中点<br /> ;;(setq mid_ptA (mid_2point pt1 pt2))<br /> (defun mid_2point (e1 e2)<br />   (setq        mid (mapcar '(lambda (x y) (/ (+ x y) 2))<br />                     e1<br />                     e2<br />             )<br />   )<br /> )

start4444

(defun c:tt5 (/ d ent1 ent3 h os p1 p1x p1y p2 p2x p2y pa1 pa2 pt2 pt3 pt4 px)  
  (setq os (getvar "OSMODE"))
  (setvar "cmdecho" 0)
  (if (= nil (setq h (getint "\n请输入分格数<4>:")))
                (setq h 4)
  )
  (setq p1 (getpoint "\n指定第一点:"))
  (command "rectang" p1 pause)
  (setq p2 (getvar "lastpoint"))
(if (>  (car p1) (car p2)) (setq px p1 p1 p2 p2 px))
        (setq
                p1x (car p1)
                p1y (cadr p1)
                p2x (car p2)
                p2y (cadr p2)
  )
  (setq pt3 (list (+ p1x (/ (- p2x p1x) h)) p2y))
  (setq pt2 (list p1x p2y))
  (setq pt4 (list (+ p1x (/ (- p2x p1x) h)) p1y))
  (setq pa1 (mid_2point p1 pt2))
  (setq pa2 (mid_2point pt3 pt4))
  (setvar "OSMODE" 0)
        (command "pline" pt3 pa1 pt4 "")
        (setq ent1 (entlast) d (/ (abs (- p1x p2x)) h))
        (command "line" pt3 pt4 "")
        (setq ent3 (entlast))
        (repeat (1- h)
                (command "MIRROR" ent1 ""  pt3 pt4 "N")(setq ent1 (entlast))
                (command "COPY" ent3 "" pt3 (polar pt3 0 d))        (setq ent3 (entlast))
                (setq pt3 (polar pt3 0 d) pt4 (polar pt4 0 d))
        )
        (if (= (rem h 2)1) (command "MIRROR" ent1 ""  (polar pt3 0 (* -0.5 d)) (polar pt4 0 (* -0.5 d)) "y"))
  (setvar "OSMODE" os)
  (princ)
)
;;求两点的中点
;(setq mid_ptA (mid_2point pt1 pt2))
(defun mid_2point(e1 e2)
        (setq mid (mapcar '(lambda (x y) (/ (+ x y) 2))
                                                        e1
                                                        e2
                                                ))
)

depgfdepgf

start4444大佬可以帮忙再次看下不，还有点小BUG

hd654

可以点选封闭区域实现以上功能吗？不用选对角顶点

nayipiantian999

start4444 发表于 2023-7-7 17:33
(defun c:tt5 (/ d ent1 ent3 h os p1 p1x p1y p2 p2x p2y pa1 pa2 pt2 pt3 pt4 px)  
  (setq os (getv ...

大佬这个如何改成左边单开？

depgfdepgf

depgfdepgf 发表于 2023-7-7 20:29
start4444大佬可以帮忙再次看下不，还有点小BUG

谢谢start4444大佬！很完美了，感谢！

xyp1964