哪位大师帮忙改下

luoms2008

(defun boundbox(ent / mi ma)
(vla-getboundingbox (vlax-ename->vla-object ent) 'mi 'ma)
(list (vlax-safearray->list mi)(vlax-safearray->list ma)))
(defun midpoint (pt1 pt2)(mapcar '(lambda(x y) (/ (+ x y) 2.0)) pt1 pt2))
(defun point(pbase sx sy)(list (+ (car pbase) sx)(+ (cadr pbase) sy)))
(defun getbop(lss ip / el lss)
        (setq el (cdr (assoc 5 (entget (entlast)))))
        (vl-cmdf "boundary" "A" "I" "N" "N" "B" "N" lss "" "" "none" ip "")
        (if  (/= el (cdr (assoc 5 (entget (entlast)))))(entlast) nil))
(defun pfdyx(ent spn jx hv)
        (setq spn 5 jx 10)
        (setq pt (boundbox ent) bp (car pt) kd (- (car (cadr pt))(car bp)) gd (- (cadr (cadr pt))(cadr bp)))
        (setq xkd (/ (- kd (* (1- spn) jx)) spn))
        (setq ss (ssadd)) (ssadd ent ss)
        (repeat spn
        (setq p1 (point bp xkd -1) p2 (point p1 0 (+ gd 2)))
        (setq p3 (point p1 jx 0) p4 (point p2 jx 0))
        (setq p5 (point bp (* 0.5 xkd) -1) p6 (point p5 0 (+ gd 2)))
        (setq bp (point p3 0 1))
        (if (< (car bp)(car(cadr pt)))
(progn        (entmake (list (cons 0 "LINE")(cons 10 p1)(cons 11 p2)))(ssadd (entlast) ss)
                (entmake (list (cons 0 "LINE")(cons 10 p3)(cons 11 p4)))(ssadd (entlast) ss)  ))
                (entmake (list (cons 0 "LINE")(cons 10 p5)(cons 11 p6)))
                (setq plst (vlax-invoke (vlax-ename->vla-object (entlast)) 'IntersectWith (vlax-ename->vla-object ent) acextendnone))
                (entdel (entlast))
                (setq i -3 ptlst nil)
   (while(nth(setq i (+ i 3))plst)(setq ptlst(cons(list(nth i plst)(nth(1+ i) plst))ptlst)))
                (setq ptlst (vl-sort ptlst (function(lambda(e1 e2)(< (cadr e1)(cadr e2))))))
                (getbop ss (trans (midpoint (car ptlst)(cadr ptlst)) 0 1))
        )(vl-cmdf "erase" ss "")(princ))

(defun pfdyx(ent spn jx hv / pt bp kd gd ss p1 p2 p3 p4 p5 p6 bp plst ptlst i)
(setq pt (boundbox ent) bp (car pt) kd (- (nth hv (cadr pt))(nth hv bp)) gd (- (nth (- 1 hv) (cadr pt))(nth (- 1 hv) bp)))
        (setq xkd (/ (- kd (* (1- spn) jx)) spn))
        (setq ss (ssadd)) (ssadd ent ss)
(repeat spn(if (= hv 0)
                    (progn        (setq p1 (point bp xkd -1) p2 (point p1 0 (+ gd 2)))
                        (setq p3 (point p1 jx 0) p4 (point p2 jx 0))
                        (setq p5 (point bp (* 0.5 xkd) -1) p6 (point p5 0 (+ gd 2)))
                        (setq bp (point p3 0 1))                    )
                    (progn        (setq p1 (point bp -1 xkd) p2 (point p1 (+ gd 2) 0))
                        (setq p3 (point p1 0 jx) p4 (point p2 0 jx))
                        (setq p5 (point bp -1 (* 0.5 xkd)) p6 (point p5 (+ gd 2) 0))
                        (setq bp (point p3 1 0))                    )                )
                (if (< (nth hv bp)(nth hv (cadr pt)))
(progn        (entmake (list (cons 0 "LINE")(cons 10 p1)(cons 11 p2)))(ssadd (entlast) ss)
                (entmake (list (cons 0 "LINE")(cons 10 p3)(cons 11 p4)))(ssadd (entlast) ss)    ))
                (entmake (list (cons 0 "LINE")(cons 10 p5)(cons 11 p6)))
                (setq plst (vlax-invoke (vlax-ename->vla-object (entlast)) 'IntersectWith (vlax-ename->vla-object ent) acextendnone))
                (entdel (entlast))
                (setq i -3 ptlst nil)
(while(nth(setq i (+ i 3))plst)(setq ptlst(cons(list(nth i plst)(nth (1+ i) plst))ptlst)))
(setq ptlst (vl-sort ptlst (function(lambda(e1 e2)(< (nth (- 1 hv) e1)(nth (- 1 hv) e2))))))
        (getbop ss (trans (midpoint (car ptlst)(cadr ptlst)) 0 1))
        )(vl-cmdf "erase" ss "")(princ))

(defun c:df( / dd jx pfstr dd1)
   (setq dd1 (getpoint "\n指定封闭图形内一点 "))
  (vl-cmdf "-boundary" dd1 "")
  (if (not hv)(setq hv 1))
   (if (not pfdyxjx)(setq pfdyxjx 30))
   (if (not pfdyxjx1)(setq pfdyxjx1 30))
   (if (not pfdyxspn)(setq pfdyxspn 3))
(setq dclf (vl-filename-mktemp "dcl.dcl") tpf (open dclf "W"))
        (foreach pfstr (setq tempdcllst (list
            "pf:dialog{label=\"平分闭合区域\";        "
           ":edit_box{label=\" 平分间距 \";key=\"jx\";}"
           ":edit_box{label=\"离边界距离\";key=\"jx1\";}"
           ":edit_box{label=\" 平分数量 \";key=\"spn\";}"
         ":row{:radio_button{label=\"水平平分\";key=\"1\";} :radio_button{label=\"垂直平分\";key=\"0\";}}        "
            "ok_cancel;}        "        ))  
        (write-line pfstr tpf))
        (close tpf)
        (while (null (findfile dclf)) (princ))
        (new_dialog "pf" (load_dialog dclf))
        (set_tile "jx" (rtos pfdyxjx))
        (set_tile "jx1" (rtos pfdyxjx1))
        (set_tile "spn" (itoa pfdyxspn))
        (action_tile "jx" "(setq pfdyxjx (atoi $value))")
        (action_tile "jx1" "(setq pfdyxjx1 (atoi $value))")
        (action_tile "spn" "(setq pfdyxspn (atoi $value))")
        (if (= hv 1)(set_tile "1" "1")(set_tile "0" "1"))
        (action_tile "0" "(setq hv (atoi $key))")
        (action_tile "1" "(setq hv (atoi $key))")
        (action_tile "cancel" "(done_dialog 0)")
        (action_tile "accept" "(done_dialog 1)")
        (vl-file-delete dclf)
        (setq dd (start_dialog) tpf nil dclf nil)
        (if (= dd 0)(vl-exit-with-value 0))
   (if (/= pfdyxjx1 0)(command "offset" "e" "y" pfdyxjx1 (entlast) dd1 "" ))
   (pfdyx (entlast) pfdyxspn pfdyxjx hv)
(princ))
求哪位大师帮忙改下平分间距跟离边界能帮改成浮点数值；比如说：2.3和2.66这类的都用，目前只能是整数，如运行时输入2.5，直接是2进行运算

xyp1964

1. (defun boundbox (ent / mi ma)
   
2.   (vla-getboundingbox (vlax-ename->vla-object ent) 'mi 'ma)
   
3.   (list (vlax-safearray->list mi) (vlax-safearray->list ma))
   
4. )
   
5. (defun midpoint (p1 p2)
   
6.   (mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p2)
   
7. )
   
8. (defun point (p0 dx dy)
   
9.   (list (+ (car p0) dx) (+ (cadr p0) dy))
   
10. )
    
11. 
    
12. (defun getbop (lss ip / el lss)
    
13.   (setq el (cdr (assoc 5 (entget (entlast)))))
    
14.   (vl-cmdf "boundary" "A" "I" "N" "N" "B" "N" lss "" "" "none" ip "")
    
15.   (if (/= el (cdr (assoc 5 (entget (entlast)))))
    
16.     (entlast)
    
17.     nil
    
18.   )
    
19. )
    
20. 
    
21. (defun pfdyx (ent spn jx hv / pt bp kd gd ss p1 p2 p3 p4 p5 p6 bp plst ptlst i)
    
22.   (setq pt  (boundbox ent)
    
23.         bp  (car pt)
    
24.         kd  (- (nth hv (cadr pt)) (nth hv bp))
    
25.         gd  (- (nth (- 1 hv) (cadr pt)) (nth (- 1 hv) bp))
    
26.         xkd (/ (- kd (* (1- spn) jx)) spn)
    
27.         ss  (ssadd)
    
28.   )
    
29.   (ssadd ent ss)
    
30.   (repeat spn
    
31.     (if (= hv 0)
    
32.       (setq p1 (point bp xkd -1)
    
33.             p2 (point p1 0 (+ gd 2))
    
34.             p3 (point p1 jx 0)
    
35.             p4 (point p2 jx 0)
    
36.             p5 (point bp (* 0.5 xkd) -1)
    
37.             p6 (point p5 0 (+ gd 2))
    
38.             bp (point p3 0 1)
    
39.       )
    
40.       (setq p1 (point bp -1 xkd)
    
41.             p2 (point p1 (+ gd 2) 0)
    
42.             p3 (point p1 0 jx)
    
43.             p4 (point p2 0 jx)
    
44.             p5 (point bp -1 (* 0.5 xkd))
    
45.             p6 (point p5 (+ gd 2) 0)
    
46.             bp (point p3 1 0)
    
47.       )
    
48.     )
    
49.     (if (< (nth hv bp) (nth hv (cadr pt)))
    
50.       (progn
    
51.         (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))
    
52.         (ssadd (entlast) ss)
    
53.         (entmake (list (cons 0 "LINE") (cons 10 p3) (cons 11 p4)))
    
54.         (ssadd (entlast) ss)
    
55.       )
    
56.     )
    
57.     (entmake (list (cons 0 "LINE") (cons 10 p5) (cons 11 p6)))
    
58.     (setq plst (vlax-invoke
    
59.                  (vlax-ename->vla-object (entlast))
    
60.                  'IntersectWith
    
61.                  (vlax-ename->vla-object ent)
    
62.                  acextendnone
    
63.                )
    
64.     )
    
65.     (entdel (entlast))
    
66.     (setq i -3
    
67.           ptlst nil
    
68.     )
    
69.     (while (nth (setq i (+ i 3)) plst)
    
70.       (setq ptlst (cons (list (nth i plst) (nth (1+ i) plst)) ptlst))
    
71.     )
    
72.     (setq ptlst (vl-sort ptlst
    
73.                          '(lambda (e1 e2) (< (nth (- 1 hv) e1) (nth (- 1 hv) e2)))
    
74.                 )
    
75.     )
    
76.     (getbop ss (trans (midpoint (car ptlst) (cadr ptlst)) 0 1))
    
77.   )
    
78.   (vl-cmdf "erase" ss "")
    
79.   (princ)
    
80. )
    
81. 
    
82. (defun c:tt (/ dd jx pfstr dd1)
    
83.   (setq dd1 (getpoint "\n指定封闭图形内一点: "))
    
84.   (vl-cmdf "-boundary" dd1 "")
    
85.   (if (not hv)
    
86.     (setq hv 1)
    
87.   )
    
88.   (if (not pfdyxjx)
    
89.     (setq pfdyxjx 30.)
    
90.   )
    
91.   (if (not pfdyxjx1)
    
92.     (setq pfdyxjx1 30.)
    
93.   )
    
94.   (if (not pfdyxspn)
    
95.     (setq pfdyxspn 3)
    
96.   )
    
97.   (setq dclf (vl-filename-mktemp "dcl.dcl")
    
98.         tpf  (open dclf "W")
    
99.   )
    
100.   (foreach pfstr (setq tempdcllst
     
101.                         (list
     
102.                           "pf:dialog{label=\"平分闭合区域\";"                           ":edit_box{label=\" 平分间距 \";key=\"jx\";}"
     
103.                           ":edit_box{label=\"离边界距离\";key=\"jx1\";}"                ":edit_box{label=\" 平分数量 \";key=\"spn\";}"
     
104.                           ":row{:radio_button{label=\"水平平分\";key=\"1\";} "          ":radio_button{label=\"垂直平分\";key=\"0\";}}"
     
105.                           "ok_cancel;}        "
     
106.                          )
     
107.                  )
     
108.     (write-line pfstr tpf)
     
109.   )
     
110.   (close tpf)
     
111.   (while (null (findfile dclf)) (princ))
     
112.   (new_dialog "pf" (load_dialog dclf))
     
113.   (set_tile "jx" (rtos pfdyxjx 2 2))
     
114.   (set_tile "jx1" (rtos pfdyxjx1 2 2))
     
115.   (set_tile "spn" (itoa pfdyxspn))
     
116.   (action_tile "jx" "(setq pfdyxjx (atof $value))")
     
117.   (action_tile "jx1" "(setq pfdyxjx1 (atof $value))")
     
118.   (action_tile "spn" "(setq pfdyxspn (atoi $value))")
     
119.   (if (= hv 1)
     
120.     (set_tile "1" "1")
     
121.     (set_tile "0" "1")
     
122.   )
     
123.   (action_tile "0" "(setq hv (atoi $key))")
     
124.   (action_tile "1" "(setq hv (atoi $key))")
     
125.   (action_tile "cancel" "(done_dialog 0)")
     
126.   (action_tile "accept" "(done_dialog 1)")
     
127.   (vl-file-delete dclf)
     
128.   (setq dd   (start_dialog)
     
129.         tpf  nil
     
130.         dclf nil
     
131.   )
     
132.   (if (= dd 0)
     
133.     (vl-exit-with-value 0)
     
134.   )
     
135.   (if (/= pfdyxjx1 0)
     
136.     (command "offset" "e" "y" pfdyxjx1 (entlast) dd1 "")
     
137.   )
     
138.   (pfdyx (entlast) pfdyxspn pfdyxjx hv)
     
139.   (princ)
     
140. )

(defun boundbox (ent / mi ma)<br />   (vla-getboundingbox (vlax-ename->vla-object ent) 'mi 'ma)<br />   (list (vlax-safearray->list mi) (vlax-safearray->list ma))<br /> )<br /> (defun midpoint (p1 p2)<br />   (mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p2)<br /> )<br /> (defun point (p0 dx dy)<br />   (list (+ (car p0) dx) (+ (cadr p0) dy))<br /> )<br /> <br /> (defun getbop (lss ip / el lss)<br />   (setq el (cdr (assoc 5 (entget (entlast)))))<br />   (vl-cmdf "boundary" "A" "I" "N" "N" "B" "N" lss "" "" "none" ip "")<br />   (if (/= el (cdr (assoc 5 (entget (entlast)))))<br />     (entlast)<br />     nil<br />   )<br /> )<br /> <br /> (defun pfdyx (ent spn jx hv / pt bp kd gd ss p1 p2 p3 p4 p5 p6 bp plst ptlst i)<br />   (setq pt  (boundbox ent)<br />         bp  (car pt)<br />         kd  (- (nth hv (cadr pt)) (nth hv bp))<br />         gd  (- (nth (- 1 hv) (cadr pt)) (nth (- 1 hv) bp))<br />         xkd (/ (- kd (* (1- spn) jx)) spn)<br />         ss  (ssadd)<br />   )<br />   (ssadd ent ss)<br />   (repeat spn<br />     (if (= hv 0)<br />       (setq p1 (point bp xkd -1)<br />             p2 (point p1 0 (+ gd 2))<br />             p3 (point p1 jx 0)<br />             p4 (point p2 jx 0)<br />             p5 (point bp (* 0.5 xkd) -1)<br />             p6 (point p5 0 (+ gd 2))<br />             bp (point p3 0 1)<br />       )<br />       (setq p1 (point bp -1 xkd)<br />             p2 (point p1 (+ gd 2) 0)<br />             p3 (point p1 0 jx)<br />             p4 (point p2 0 jx)<br />             p5 (point bp -1 (* 0.5 xkd))<br />             p6 (point p5 (+ gd 2) 0)<br />             bp (point p3 1 0)<br />       )<br />     )<br />     (if (< (nth hv bp) (nth hv (cadr pt)))<br />       (progn<br />         (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))<br />         (ssadd (entlast) ss)<br />         (entmake (list (cons 0 "LINE") (cons 10 p3) (cons 11 p4)))<br />         (ssadd (entlast) ss)<br />       )<br />     )<br />     (entmake (list (cons 0 "LINE") (cons 10 p5) (cons 11 p6)))<br />     (setq plst (vlax-invoke<br />                  (vlax-ename->vla-object (entlast))<br />                  'IntersectWith<br />                  (vlax-ename->vla-object ent)<br />                  acextendnone<br />                )<br />     )<br />     (entdel (entlast))<br />     (setq i -3<br />           ptlst nil<br />     )<br />     (while (nth (setq i (+ i 3)) plst)<br />       (setq ptlst (cons (list (nth i plst) (nth (1+ i) plst)) ptlst))<br />     )<br />     (setq ptlst (vl-sort ptlst<br />                          '(lambda (e1 e2) (< (nth (- 1 hv) e1) (nth (- 1 hv) e2)))<br />                 )<br />     )<br />     (getbop ss (trans (midpoint (car ptlst) (cadr ptlst)) 0 1))<br />   )<br />   (vl-cmdf "erase" ss "")<br />   (princ)<br /> )<br /> <br /> (defun c:tt (/ dd jx pfstr dd1)<br />   (setq dd1 (getpoint "\n指定封闭图形内一点: "))<br />   (vl-cmdf "-boundary" dd1 "")<br />   (if (not hv)<br />     (setq hv 1)<br />   )<br />   (if (not pfdyxjx)<br />     (setq pfdyxjx 30.)<br />   )<br />   (if (not pfdyxjx1)<br />     (setq pfdyxjx1 30.)<br />   )<br />   (if (not pfdyxspn)<br />     (setq pfdyxspn 3)<br />   )<br />   (setq dclf (vl-filename-mktemp "dcl.dcl")<br />         tpf  (open dclf "W")<br />   )<br />   (foreach pfstr (setq tempdcllst<br />                         (list<br />                           "pf:dialog{label=\"平分闭合区域\";"                           ":edit_box{label=\" 平分间距 \";key=\"jx\";}"<br />                           ":edit_box{label=\"离边界距离\";key=\"jx1\";}"                ":edit_box{label=\" 平分数量 \";key=\"spn\";}"<br />                           ":row{:radio_button{label=\"水平平分\";key=\"1\";} "          ":radio_button{label=\"垂直平分\";key=\"0\";}}"<br />                           "ok_cancel;}        "<br />                          )<br />                  )<br />     (write-line pfstr tpf)<br />   )<br />   (close tpf)<br />   (while (null (findfile dclf)) (princ))<br />   (new_dialog "pf" (load_dialog dclf))<br />   (set_tile "jx" (rtos pfdyxjx 2 2))<br />   (set_tile "jx1" (rtos pfdyxjx1 2 2))<br />   (set_tile "spn" (itoa pfdyxspn))<br />   (action_tile "jx" "(setq pfdyxjx (atof $value))")<br />   (action_tile "jx1" "(setq pfdyxjx1 (atof $value))")<br />   (action_tile "spn" "(setq pfdyxspn (atoi $value))")<br />   (if (= hv 1)<br />     (set_tile "1" "1")<br />     (set_tile "0" "1")<br />   )<br />   (action_tile "0" "(setq hv (atoi $key))")<br />   (action_tile "1" "(setq hv (atoi $key))")<br />   (action_tile "cancel" "(done_dialog 0)")<br />   (action_tile "accept" "(done_dialog 1)")<br />   (vl-file-delete dclf)<br />   (setq dd   (start_dialog)<br />         tpf  nil<br />         dclf nil<br />   )<br />   (if (= dd 0)<br />     (vl-exit-with-value 0)<br />   )<br />   (if (/= pfdyxjx1 0)<br />     (command "offset" "e" "y" pfdyxjx1 (entlast) dd1 "")<br />   )<br />   (pfdyx (entlast) pfdyxspn pfdyxjx hv)<br />   (princ)<br /> )

xyp1964

试试这种的：

技术工作室

xyp1964  的东西就是好

qazxswk

楼主的代码似曾相识呀。