就是一个绘制起拱橱柜门的程序

cq4920

本来是加了顶点连接的程序,但是不知道为什么,其中有两组点的连线是混乱的!也就删了!没什么技术!部分函数没有整理上传!

(defun C:mb2( / vla_e1 vla_e2 pts1 pts2 fglst lst_dist&p pta ent ss p1 p2 p3 p4 ent1 ent2 ent3 ent4 ent5 a b )
(jiany0001)
(MC:be1);初始变量
                        (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 p3 (vlax-safearray->list maxpoint)
                                p1 (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洞口不是矩形，手动选择矩形的第一点"))
    (if (setq p3 (getcorner p1 "\n第二点<空格按尺寸绘制>"))
                (progn
                        (setvar "OSMODE" 0)
                        (command "rectang" p1 p3)
                )
                (progn
                        (if (= (setq a (getdist"\n设置宽度<默认值400>")) nil)
                                (setq a 400))
                        (if (= (setq b (getdist"\n设置高度<默认值660>")) nil)
                                (setq b 660))
                        (setvar "OSMODE" 0)
                        (command "rectang" p1 "d" a b pause )
                )
        )
     (setq ent (entlast))
     (vl-load-com)
     (vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
     (setq p3 (vlax-safearray->list maxpoint)
           p1 (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第一点"))
            (if (setq p3 (getcorner p1 "\n第二点<空格按尺寸绘制>"))
                (progn
                        (setvar "OSMODE" 0)
                        (command "rectang" p1 p3)
                )
                (progn
                        (if (= (setq a (getdist"\n设置宽度<默认值400>")) nil)
                                (setq a 400))
                        (if (= (setq b (getdist"\n设置高度<默认值660>")) nil)
                                (setq b 660))
                        (setvar "OSMODE" 0)
                        (command "rectang" p1 "d" a b pause )
                )
        )
     (setq ent (entlast))
     (vl-load-com)
     (vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
     (setq p3 (vlax-safearray->list maxpoint)
           p1 (vlax-safearray->list minpoint))
               (setq p2 (list (car p3) (cadr p1)))
         (setq p4 (list (car p1) (cadr p3)));外框线点定位
         ;(COMMAND "_.erase"  ENT "")
        )
        )
       
        (if (null(setq ne (getdist "\n->输入门边尺寸<60>: ")))
                (setq ne 60))
(setvar "OSMODE" 0)
(COMMAND "offset" ne ent (Mc:Md p1 p3) "")
(setq ent1 (entlast))
       
(setq ss (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent1))))
        (if (= (length ss) 4)
                  (progn
                        (vl-load-com)
                        (vla-getboundingbox (vlax-ename->vla-object ent1) 'minpoint 'maxpoint)
                        (setq pa3 (vlax-safearray->list maxpoint)
                                pa1 (vlax-safearray->list minpoint))
                        (setq pa2 (list (car pa3) (cadr pa1)))
                        (setq pa4 (list (car pa1) (cadr pa3)))
      (COMMAND "_.erase"  ENT1 "")
                     )
        (princ "\n洞口不是矩形！已退出!"))
       
(setq p5 (polar pa4 (* pi -0.5) 40))
(setq p6 (polar pa3(* pi -0.5) 40))       
(setq p7 (polar p5 0 40))       
(setq p8 (polar p6  pi  40))       
(setq p9        (Mc:Md pa3 pa4))
       
        (entmake (list
                                                                 '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 6) '(70 . 0) (cons 10 p7) (cons 10 p5)(cons 10 pa1) (cons 10 pa2)(cons 10 p6)(cons 10 p8)))       
(COMMAND "arc"  p8 p9 p7 )
            (setvar 'peditaccept 1)
      (command "_.pedit" "_M" (last_ent ent2) "" "_J" "" "")
         (setq ent2d (entlast))
(COMMAND "offset" 3 ent2d (Mc:Md p1 p3) "")
(setq ent2a (entlast))               
(COMMAND "offset" 12 ent2a (Mc:Md p1 p3) "")
(setq ent3 (entlast))
        (COMMAND "offset" 3 ent3 (Mc:Md p1 p3) "")
(setq ent3a (entlast))
        (COMMAND "offset" 18 ent3a (Mc:Md p1 p3) "")
(setq ent4 (entlast))       
        (COMMAND "offset" 4 ent4(Mc:Md p1 p3) "")


       
(MC:be11);;变量还原
)
       
       
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;将表内元素每2个进行分割重新组表;;平行连接;;;;;;;;;;;;;;;;;;;;;;;
(defun fgb(lst1 / fglst1 dxf10 n)
        (setq n 0 i 0)
        (repeat (/(length lst1)2)
                (repeat 2
                        (setq  dxf10 (nth n lst1))
                        (setq fglst1 (append fglst1 (list dxf10 )))
                        (setq n (1+ n))
    )
                (setq fglst (append  fglst (list fglst1 )))
                (setq fglst1 nil)
                (setq i(1+ i))
  )
)

AndyWang

函数不传，岂不是用不了？还是传下吧，测试下，我做柜子的，看看有什么可以借鉴的

taoyi0727

做柜子的报到

nochao

楼主方便把这个函数补充一下吗？错误: no function definition: LAST_ENT

yoyoho

nochao 发表于 2021-3-19 18:31
楼主方便把这个函数补充一下吗？错误: no function definition: LAST_ENT

;;最后生产出的图元
(defun last_ent (en / ss)
  (if en
    (progn
      (setq ss (ssadd))
      (while (setq en (entnext en))
        (if (not (member (cdr (assoc 0 (entget en)))
                   '("ATTRIB" "VERTEX" "SEQEND")
                 )
            )
          (ssadd en ss)
        );if
      );while
      (if (zerop (sslength ss)) (setq ss nil))
      ss
    );progn
    (ssget "_x")
  );if
)

nochao

yoyoho 发表于 2021-3-20 22:15
;;最后生产出的图元
(defun last_ent (en / ss)
  (if en

谢谢热心分享