stonedesign 发表于 2021-8-15 15:41:03

请求帮助,把画柜子的等分加强下

(defun C:df( / )
          (setq cm (getvar "cmdecho")
                os (getvar "osmode"))
(setvar "CMDECHO" 0)       
       
   (command "color" "bylayer")
       (command "_undo" "be")
                (if (setq pta (getpoint "\n层板位置<空格>两点定位"))
        (progn
        (COMMAND "-BOUNDARY" pta "")
        (setq ent (entlast))       
        (setq ss (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))))
        (if (= (length ss) 4)
                (progn
                        (vl-load-com)       
                        (vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
                        (setq p1 (vlax-safearray->list maxpoint)
                                p3 (vlax-safearray->list minpoint))
                        (setq p2 (list (car p3) (cadr p1)))
                        (setq p4 (list (car p1) (cadr p3)))       
      (COMMAND "_.erase"ENT "")                       
                )
                (progn
                (COMMAND "_.erase"ENT "")       
                (setq p1 (getpoint"\n洞口不是矩形,手动选择矩形的第一点"))
    (setq p3 (getcorner p1 "\n第二点"))
        (setvar "osmode" 0)
    (command "rectang" p1 p3)
   (setq ent (entlast))
   (vl-load-com)
   (vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
   (setq p1 (vlax-safearray->list maxpoint)
         p3 (vlax-safearray->list minpoint))
             (setq p2 (list (car p3) (cadr p1)))
         (setq p4 (list (car p1) (cadr p3)));外框线点定位       
         (COMMAND "_.erase"ENT ""))       
        )       
        )
                (progn
    (setq p1 (getpoint"\n第一点"))
    (setq p3 (getcorner p1 "\n第二点"))
        (setvar "osmode" 0)
    (command "rectang" p1 p3)
   (setq ent (entlast))
   (vl-load-com)
   (vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
   (setq p1 (vlax-safearray->list maxpoint)
         p3 (vlax-safearray->list minpoint))
             (setq p2 (list (car p3) (cadr p1)))
         (setq p4 (list (car p1) (cadr p3)));外框线点定位       
         (COMMAND "_.erase"ENT "")
        )       
        )
        (setq nl (getdist"\n层板厚度"))
        (setq n (getint"\n层板数量"))
        (setq gl (distance p1 p4))
        (setq kl (distance p1 p2))
        (setq l (/ (- gl (* nl n)) (1+ n)))
        (repeat n
        (setq ptn (polar p1 (angle p2 p3) l))
        (setq ptny (polar ptn (angle p4 p3) kl))
(entmake (list '(0 . "LINE") (cons 10 ptn) (cons 11 ptny)))
        (setq ptn1 (polar ptn (angle p2 p3) nl))
        (setq ptn1y (polar ptn1 (angle p4 p3) kl))
(entmake (list '(0 . "LINE") (cons 10 ptn1) (cons 11 ptn1y)))       
        (setq p1 ptn1)       
        )
        (setvar "CMDECHO" cm)
        (setvar "osmode" os)
)



有大师能把这个改改吗,想要竖的效果也有他只有横的


小毛草 发表于 2021-8-19 10:09:41

竖向等分板,按上楼的方向,加了默认值,方便一点,不用每处都要自已输入
(defun C:ddf( / )
            (setq cm (getvar "cmdecho")
                  os (getvar "osmode"))
(setvar "CMDECHO" 0)      
         
   (command "color" "bylayer")
         (command "_undo" "be")
                (if (setq pta (getpoint "\n层板位置<空格>两点定位"))
      (progn
      (COMMAND "-BOUNDARY" pta "")
      (setq ent (entlast))      
      (setq ss (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))))
      (if (= (length ss) 4)
                (progn
                        (vl-load-com)      
                        (vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
                        (setq p1 (vlax-safearray->list maxpoint)
                              p3 (vlax-safearray->list minpoint))
                        (setq p2 (list (car p3) (cadr p1)))
                        (setq p4 (list (car p1) (cadr p3)))      
      (COMMAND "_.erase"ENT "")                     
                )
                (progn
                (COMMAND "_.erase"ENT "")      
                (setq p1 (getpoint"\n洞口不是矩形,手动选择矩形的第一点"))
    (setq p3 (getcorner p1 "\n第二点"))
      (setvar "osmode" 0)
    (command "rectang" p1 p3)
   (setq ent (entlast))
   (vl-load-com)
   (vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
   (setq p1 (vlax-safearray->list maxpoint)
         p3 (vlax-safearray->list minpoint))
               (setq p2 (list (car p3) (cadr p1)))
         (setq p4 (list (car p1) (cadr p3)));外框线点定位         
         (COMMAND "_.erase"ENT ""))      
      )      
      )
                (progn
    (setq p1 (getpoint"\n第一点"))
    (setq p3 (getcorner p1 "\n第二点"))
      (setvar "osmode" 0)
    (command "rectang" p1 p3)
   (setq ent (entlast))
   (vl-load-com)
   (vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
   (setq p1 (vlax-safearray->list maxpoint)
         p3 (vlax-safearray->list minpoint))
               (setq p2 (list (car p3) (cadr p1)))
         (setq p4 (list (car p1) (cadr p3)));外框线点定位         
         (COMMAND "_.erase"ENT "")
      )      
      )
      (setq nl (getdist"\n层板厚度<20>"))
                (if (= nl nil) (setq nl 20))
      (setq n (getint"\n层板数量<5>"))
                (if (= n nil) (setq n 5))
      (setq gl (distance p1 p4))
      (setq kl (distance p1 p2))
      (setq l (/ (- gl (* nl n)) (1+ n)))
      (repeat n
          (setq l (/ (- kl (* nl n)) (1+ n)))
       (setq ptn (polar p1 (angle p4 p3) l))
      (setq ptny (polar ptn (angle p2 p3) gl))
(entmake (list '(0 . "LINE") (cons 10 ptn) (cons 11 ptny)))
      (setq ptn1 (polar ptn (angle p4 p3) nl))
      (setq ptn1y (polar ptn1 (angle p2 p3) gl))
(entmake (list '(0 . "LINE") (cons 10 ptn1) (cons 11 ptn1y)))      
      (setq p1 ptn1)      
      )
      (setvar "CMDECHO" cm)
      (setvar "osmode" os)
)

小毛草 发表于 2021-8-19 10:11:11

水平方向的等分板有一个更简单的,基本上差不多,别的网友写的,
;;;;;;等分板
(defun c:DFF()
(setvar "CMDECHO" 0)
(setq os (getvar "OSMODE"))
(setq p1 (getpoint "\n左上角点:")
       p3 (getcorner p1 "\n右下角点:"))
(setq p1x (car p1)
       p1y (cadr p1)
       p3x (car p3)
       p3y (cadr p3)
       p2(list p3x p1y)
       p4(list p1x p3y))
(setq ch (getdist "\n请输入中间层板厚度<20>: "))
(if (= ch nil) (setq ch 20))
(setq df (getdist "\n请输入风格数<5>: "))
(setq df (if (= df nil) 5 (fix df)))
(setq A (distance p1 p4))
(setq x (/ (- A (* (1- df) ch)) df))
(command "line" (polar p4 (* pi 0.5) x) (polar p3 (* pi 0.5) x) "")
(setq s01 (entlast))
(command "_offset" ch (list s01 (polar p4 (* pi 0.5) x)) (polar (polar p4 (* pi 0.5) x) (* pi 0.5) 500) "" )
(setq ss (ssget "w" (polar p1 (* pi 1.5) 10) (polar p3 (* pi 0.5) 10) ))
(command "_array" ss "" "R" (1- df) "1" (+ x ch) "")
(setvar "CMDECHO" 1)
(princ)
)

ww5w 发表于 2021-8-17 19:54:27

把这部份改成下面的,就变成竖向的了
(repeat n
          (setq l (/ (- kl (* nl n)) (1+ n)))
       (setq ptn (polar p1 (angle p4 p3) l))
      (setq ptny (polar ptn (angle p2 p3) gl))
(entmake (list '(0 . "LINE") (cons 10 ptn) (cons 11 ptny)))
      (setq ptn1 (polar ptn (angle p4 p3) nl))
      (setq ptn1y (polar ptn1 (angle p2 p3) gl))
(entmake (list '(0 . "LINE") (cons 10 ptn1) (cons 11 ptn1y)))      
      (setq p1 ptn1)      
      )

k1nger 发表于 2021-8-16 10:09:58

直接做个动态块多省事啊,还方便修改

stonedesign 发表于 2021-8-16 11:15:24

k1nger 发表于 2021-8-16 10:09
直接做个动态块多省事啊,还方便修改

动态块有但是感觉还是这个方法好用点

写不完的日记 发表于 2021-8-17 08:51:36

这个我都弄出来用了好几年了!

写不完的日记 发表于 2021-8-17 08:52:23

写复杂了,用command调用阵列

stonedesign 发表于 2021-8-17 09:34:03

写不完的日记 发表于 2021-8-17 08:52
写复杂了,用command调用阵列

别人那里拿的,不知道你是作者呵呵

stonedesign 发表于 2021-8-19 20:26:33

谢谢大家,我这边自己也弄好了。
页: [1] 2 3
查看完整版本: 请求帮助,把画柜子的等分加强下