luoms2008 发表于 2025-4-30 15:34:55

哪位大师帮忙改下

(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 发表于 2025-4-30 15:50:56

(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 (p1 p2)
(mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p2)
)
(defun point (p0 dx dy)
(list (+ (car p0) dx) (+ (cadr p0) dy))
)

(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 / 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))
      xkd (/ (- kd (* (1- spn) jx)) spn)
      ss(ssadd)
)
(ssadd ent ss)
(repeat spn
    (if (= hv 0)
      (setq p1 (point bp xkd -1)
            p2 (point p1 0 (+ gd 2))
            p3 (point p1 jx 0)
            p4 (point p2 jx 0)
            p5 (point bp (* 0.5 xkd) -1)
            p6 (point p5 0 (+ gd 2))
            bp (point p3 0 1)
      )
      (setq p1 (point bp -1 xkd)
            p2 (point p1 (+ gd 2) 0)
            p3 (point p1 0 jx)
            p4 (point p2 0 jx)
            p5 (point bp -1 (* 0.5 xkd))
            p6 (point p5 (+ gd 2) 0)
            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
                         '(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:tt (/ 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 2 2))
(set_tile "jx1" (rtos pfdyxjx1 2 2))
(set_tile "spn" (itoa pfdyxspn))
(action_tile "jx" "(setq pfdyxjx (atof $value))")
(action_tile "jx1" "(setq pfdyxjx1 (atof $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)
      tpfnil
      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)
)

xyp1964 发表于 2025-4-30 16:19:54

试试这种的：


技术工作室 发表于 2025-4-30 20:49:51

xyp1964的东西就是好

qazxswk 发表于 2025-4-30 22:59:03

楼主的代码似曾相识呀。

hhh454 发表于 2025-5-3 00:00:47

本帖最后由 hhh454 于 2025-5-3 00:03 编辑

楼主是想画模型的百叶窗吧，假如是还要考虑单线和双线，现在用单线居多。
1楼的代码中，下面的函数没有增加参数，所以没有小数
rtos
将数字转换成字符串

(rtos number ])
根据 mode、precision 参数和系统变量 UNITMODE、DIMZIN、LUNITS 和 LUPREC 的设置，rtos 函数返回代表 number 的字符串。

参数

number

数值。

mode

整数，指定现行单位模式。mode 的取值对应于 AutoCAD 系统变量 lunits 的允许值，如下所示：

1 科学

2 小数

3 工程（英尺和十进制英寸）

4 建筑（英尺和分数英寸）

5 分数

precision

整数，指定精度。

mode 和 precision 参数对应于系统变量 LUNITS 和 LUPREC。如果省略这两个参数，rtos 函数使用 LUNITS 和 LUPREC 的当前值。

luoms2008 发表于 2025-5-3 11:32:09

xyp1964 发表于 2025-4-30 15:50


院长就是BN，！！

amook147 发表于 2025-8-28 18:59:55

xyp1964 发表于 2025-4-30 16:19
试试这种的：

大神的代码 真是没的说。。。。
页: [1]
查看完整版本: 哪位大师帮忙改下