[分享]：建筑图中画门(包括坡道),程序

szx025 · 发表于 2007-7-13 19:37:49

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

这时一个建筑图中画门的程序(包括坡道),是在论坛朋友的帮助下完成的,贡献出来供感兴趣的朋友使用.
本程序的点是用坐标的形式定义的,如果采用方向和距离来定义可能更好,有兴趣的朋友可以改良一下,改进的程序希望也在论坛公开,.

(defun mid_pt (a b)
(mapcar
'(lambda (a b) (/ (+ a b) 2))
a
b
)
)
(defun c:d1 (/ ds str pt_mid ang12 pt1 pt2 p10 p20 p30 p40 point1 point3 point4 point5 point6 point7 point8 point9 point11
)
;;保存系统变量设置
(setq old_OS (getvar "OSMODE")
old_CMD (getvar "CMDECHO")
)
(setvar "CMDECHO" 0)
(command "-osnap" "INT")
(command "-layer" "m" "mc"
"C" "4" """")
(if (setq point1 (getpoint "点取第一点:"))
(if (setq point11 (getpoint point1 "点取第二点:"))
(progn
(setq ds (/ (distance point1 point11) 100.0)
)
;;判断部分
(setvar "OSMODE" 0)
(if (<= ds 11)
;; Draw all size door
(progn
(setq point2 (list (nth 0 point1)
(+ 120 (nth 1 point1))
)
)
(setq point3 (list (nth 0 point1)
(+ (* ds 100) (nth 1 point1))
)
)
(setq point4 (list (+ 50 (nth 0 point3))
(nth 1 point3)
)
)
(setq point5 (list (+ (- (* ds 100) 50)
(nth 0 point4)
)
(- (nth 1 point4)
(- (* ds 100) 120)
)
)
)
(setq point6 (list (nth 0 point5)
(- (nth 1 point5) 120)
)
)
(setq p10 (list (- (nth 0 point2) 300)
(nth 1 point2)
)
)
(setq p20 (list (nth 0 p10)
(+ 1200 (nth 1 point1))
)
)
(setq p30 (list (+ 300 (nth 0 point5))
(nth 1 point5)
)
)
(setq p40 (list (nth 0 p30)
(+ 1200 (nth 1 point5))
)
)
(setq pt1 (list (nth 0 point6)
(- (nth 1 point6) 120)
)
)
(setq pt2 (list (nth 0 point1)
(- (nth 1 point1) 120)
)
)
(command "pline" point1 "W" "0"
"" point2 point3 point4
"arc" point5 "line" point6
""
)
(setq door (ssget "L"))
(command "pline" point2 "W" "60" "" pt2 "" )
(ssadd (entlast) door)
(command "pline" point5 "W" "60" "" pt1 "" )
(ssadd (entlast) door)
(command "rectangle" point2 point4 )
(ssadd (entlast) door)
(command "rectangle" p10 p40)
(ssadd (entlast) door)
)
;; Draw all size double door
(progn
(setq point2 (list (nth 0 point1)
(+ 120 (nth 1 point1))
)
)
(setq
point3 (list (nth 0 point1)
(+ (* ds 50) (nth 1 point1))
)
)
(setq point4 (list (+ 50 (nth 0 point3))
(nth 1 point3)
)
)
(setq point5 (list (+ (- (* ds 50) 50)
(nth 0 point4)
)
(- (nth 1 point4)
(- (* ds 50) 120)
)
)
)
(setq point6 (list (+ (- (* ds 50) 50)
(nth 0 point5)
)
(+ (- (* ds 50) 120)
(nth 1 point5)
)
)
)
(setq point7 (list (+ 50 (nth 0 point6))
(nth 1 point6)
)
)
(setq point8
(list (nth 0 point7)
(- (nth 1 point7) (- (* ds 50) 120))
)
)
(setq point9 (list (nth 0 point8)
(- (nth 1 point8) 120)
)
)
(setq p10 (list (- (nth 0 point2) 500)
(nth 1 point2)
)
)
(setq p20 (list (nth 0 p10)
(+ 1500 (nth 1 point2))
)
)
(setq p30 (list (+ 500 (nth 0 point7))
(nth 1 point5)
)
)
(setq p40 (list (nth 0 p30)
(+ 1500 (nth 1 point5))
)
)
(setq pt1 (list (nth 0 point9)
(- (nth 1 point9) 120)
)
)
(setq pt2 (list (nth 0 point1)
(- (nth 1 point1) 120)
)
)
(command "pline" point1 "W" "0"
"" point2 point3 point4
"arc" point5 "angle" "-90"
point6 "line" point7 point8
point9 ""
)
(setq door (ssget "L"))
(command "pline" point2 "W" "60" "" pt2 "" )
(ssadd (entlast) door)
(command "pline" point8 "W" "60" "" pt1 "" )
(ssadd (entlast) door)
(command "rectangle" point2 point4)
(ssadd (entlast) door)
(command "rectangle" point6 point8)
(ssadd (entlast) door)
(command "rectangle" p10 p40)
(ssadd (entlast) door)
(command "line" point2 p20 "")
(ssadd (entlast) door)
(command "line" point8 p40 "")
(ssadd (entlast) door)
)
)
;;处理选项
(command "rotate" door "" point1 point11)
(princ "\n宽度：")
(princ ds)
(initget "Yes No")
(if (= "Yes"
(getkword "\n是否镜像？[是(Y)/否(N)] <N>:")
)
(command "mirror" door "" point1 point11 "y")
)
(setq str (getstring "\n请输入文字<1>:"))
(if (= str "") (setq str (strcat "M-" "1")) (setq str (strcat "M-" str)))
(setq ang12 (angle point1 point11))
(if (> ang12 (/ Pi 2))
(setq ang12 (- ang12 Pi))
)
(setq ang12 (angtos ang12))
(setq pt_mid (mid_pt point1 point11))
(command "text" "j" "bc" pt_mid 300 ang12 str)
(princ "\n成功完成!")
)
)
)
;;恢复系统变量设置
(setvar "CMDECHO" old_CMD)
(setvar "OSMODE" old_OS)
;执行完毕返回0层
(setvar "clayer" "0")
(princ)
)

(defun mid_pt (a b) 
(mapcar 
'(lambda (a b) (/ (+ a b) 2)) 
a 
b 
) 
) 
 
(defun c:d1 (/ ds str pt_mid ang12 pt1 pt2 p10 p20 p30 p40 point1 point3 point4 point5 point6 point7 point8 point9 point11 
        ) 
    ;;保存系统变量设置 
    (setq old_OS  (getvar "OSMODE") 
      old_CMD (getvar "CMDECHO") 
    ) 
      
    (setvar "CMDECHO" 0) 
    (command "-osnap" "INT") 
(command "-layer" "m" "mc" 
               "C" "4" """") 
    (if    (setq point1 (getpoint "点取第一点:")) 
    (if (setq point11 (getpoint point1 "点取第二点:")) 
        (progn 
        (setq ds (/ (distance point1 point11) 100.0) 
        ) 
        ;;判断部分 
        (setvar "OSMODE" 0) 
        (if (<= ds 11) 
            ;; Draw all size door 
            (progn 
            (setq point2 (list (nth 0 point1) 
                       (+ 120 (nth 1 point1)) 
                     ) 
            ) 
            (setq point3 (list (nth 0 point1) 
                     (+ (* ds 100) (nth 1 point1)) 
                   ) 
            ) 
            (setq point4 (list (+ 50 (nth 0 point3)) 
                       (nth 1 point3) 
                     ) 
            ) 
            (setq point5 (list (+ (- (* ds 100) 50) 
                          (nth 0 point4) 
                       ) 
                       (- (nth 1 point4) 
                          (- (* ds 100) 120) 
                       ) 
                     ) 
            ) 
            (setq point6 (list (nth 0 point5) 
                       (- (nth 1 point5) 120) 
                     ) 
            ) 
(setq p10 (list (- (nth 0 point2) 300) 
                       (nth 1 point2) 
                     ) 
            ) 
 (setq p20 (list (nth 0 p10) 
                     (+ 1200 (nth 1 point1)) 
                   ) 
            ) 
 (setq p30 (list (+ 300 (nth 0 point5)) 
                       (nth 1 point5) 
                     ) 
            ) 
(setq p40 (list (nth 0 p30) 
                     (+ 1200 (nth 1 point5)) 
                   ) 
) 
(setq pt1 (list (nth 0 point6) 
                       (- (nth 1 point6) 120) 
                     ) 
            ) 
(setq pt2 (list (nth 0 point1) 
                       (- (nth 1 point1) 120) 
                     ) 
            ) 
 
            (command "pline"  point1   "W"        "0" 
                 ""      point2   point3   point4 
                 "arc"      point5   "line"   point6 
                 ""   
                ) 
 
            (setq door (ssget "L")) 
(command "pline"  point2  "W"   "60" "" pt2 "" ) 
(ssadd (entlast) door) 
(command "pline"  point5  "W"   "60" "" pt1 "" ) 
(ssadd (entlast) door) 
            (command "rectangle" point2 point4 ) 
            (ssadd (entlast) door) 
(command "rectangle" p10 p40) 
            (ssadd (entlast) door) 
            ) 
            ;; Draw all size double door 
            (progn 
            (setq point2 (list (nth 0 point1) 
                       (+ 120 (nth 1 point1)) 
                     ) 
            ) 
            (setq 
                point3 (list (nth 0 point1) 
                     (+ (* ds 50) (nth 1 point1)) 
                   ) 
            ) 
            (setq point4 (list (+ 50 (nth 0 point3)) 
                       (nth 1 point3) 
                     ) 
            ) 
            (setq point5 (list (+ (- (* ds 50) 50) 
                          (nth 0 point4) 
                       ) 
                       (- (nth 1 point4) 
                          (- (* ds 50) 120) 
                       ) 
                     ) 
            ) 
            (setq point6 (list (+ (- (* ds 50) 50) 
                          (nth 0 point5) 
                       ) 
                       (+ (- (* ds 50) 120) 
                          (nth 1 point5) 
                       ) 
                     ) 
            ) 
            (setq point7 (list (+ 50 (nth 0 point6)) 
                       (nth 1 point6) 
                     ) 
            ) 
            (setq point8 
                 (list (nth 0 point7) 
                       (- (nth 1 point7) (- (* ds 50) 120)) 
                 ) 
            ) 
            (setq point9 (list (nth 0 point8) 
                       (- (nth 1 point8) 120) 
                     ) 
            ) 
(setq p10 (list (- (nth 0 point2) 500) 
                       (nth 1 point2) 
                     ) 
            ) 
 (setq p20 (list (nth 0 p10) 
                     (+ 1500 (nth 1 point2)) 
                   ) 
            ) 
 (setq p30 (list (+ 500 (nth 0 point7)) 
                       (nth 1 point5) 
                     ) 
            ) 
(setq p40 (list (nth 0 p30) 
                     (+ 1500 (nth 1 point5)) 
                   ) 
) 
(setq pt1 (list (nth 0 point9) 
                       (- (nth 1 point9) 120) 
                     ) 
            ) 
(setq pt2 (list (nth 0 point1) 
                       (- (nth 1 point1) 120) 
                     ) 
            ) 
 
            (command "pline"  point1   "W"        "0" 
                 ""      point2   point3   point4 
                 "arc"      point5   "angle"  "-90" 
                 point6      "line"   point7   point8 
                 point9      "" 
                ) 
            (setq door (ssget "L")) 
(command "pline"  point2  "W"   "60" "" pt2 "" ) 
 (ssadd (entlast) door) 
(command "pline"  point8  "W"   "60" "" pt1 "" ) 
 (ssadd (entlast) door) 
            (command "rectangle" point2 point4) 
            (ssadd (entlast) door) 
            (command "rectangle" point6 point8) 
            (ssadd (entlast) door) 
(command "rectangle" p10 p40) 
            (ssadd (entlast) door) 
(command "line" point2 p20  "") 
            (ssadd (entlast) door) 
(command "line" point8 p40  "") 
            (ssadd (entlast) door)    
            ) 
        ) 
 
        ;;处理选项 
        (command "rotate" door "" point1 point11) 
        (princ "\n宽度：") 
        (princ ds) 
        (initget "Yes No") 
        (if (= "Yes" 
               (getkword "\n是否镜像？[是(Y)/否(N)] <N>:") 
            ) 
            (command "mirror" door "" point1 point11 "y") 
        ) 
(setq str (getstring "\n请输入文字<1>:")) 
(if (= str "") (setq str (strcat "M-" "1")) (setq str (strcat "M-" str))) 
(setq ang12 (angle point1 point11)) 
(if (> ang12 (/ Pi 2)) 
(setq ang12 (- ang12 Pi)) 
) 
(setq ang12 (angtos ang12))   
(setq pt_mid (mid_pt point1 point11)) 
(command "text" "j" "bc" pt_mid 300 ang12 str) 
        (princ "\n成功完成!") 
        ) 
    ) 
    ) 
    ;;恢复系统变量设置 
    (setvar "CMDECHO" old_CMD) 
    (setvar "OSMODE" old_OS) 
;执行完毕返回0层 
(setvar "clayer" "0") 
    (princ) 
)

zml84 · 发表于 2007-7-14 12:29:29

适当的注释，可以增强代码的可读性。
楼主的代码使用了较多的点位变量，若能够将点位图一并贴出，效果会更佳。

szx025 · 发表于 2007-7-14 12:47:44

论坛上贴图没有成功过,
如何做点位图?

zml84 · 发表于 2007-7-14 14:43:28

点位图就是，你在完成这段代码过程中，所使用的点位变量表示的点位在整个图形中的位置。
如果没有这张图，莫要说是他人，就是自己再过几天来读这段代码，也肯定不会容易看明白的。

coco25825 · 发表于 2008-9-5 16:38:56

大家看我这个画门程序，未考证，据说能直接画门，并给出门的方向

(defun *error*(st)
 (if (and (/= st "Function cancelled")
 (/= st "quit / exit abort")
 )
 (princ (strcat "错误: " st))
 )
 (setq *error* old_err)
 (princ)
)

(defun sort (l / lt ltem vmax vmin l1 l2 l3
 lt0 ltem0 ltem1 l30 vmax0 vmin0 l10 l20)
 (setq ltem (mapcar 'car l) ;ltem : 取出l的第一项形成的表
vmin (1- (apply 'min ltem)) ;vmin : 是一个比ltem中最小的数还小的数
 )
 (while (< vmin (setq vmax (apply 'max ltem))) ;从ltem中取出最大值
(setq l1 l l3 nil ltem (subst vmin vmax ltem)) ;去掉最大值
(while (setq l2 (assoc vmax l1)) ;取出最大值所对应的项
 (setq l1 (cdr (member l2 l1))) ;处理相同的值
 (setq l3 (cons l2 l3))
)
(progn
 (setq ltem0 (mapcar 'cadr l3)
 ltem1 (mapcar 'car l3)
 l30 (mapcar 'cdr l3)
 vmin0 (1- (apply 'min ltem0))
 )
 (while (< vmin0 (setq vmax0 (apply 'max ltem0)))
(setq l10 l30 ltem0 (subst vmin0 vmax0 ltem0))
(while (setq l20 (assoc vmax0 l10))
 (setq l10 (cdr (member l20 l10)))
 (setq lt0 (cons l20 lt0))
)
 )
 (setq l3 (mapcar 'cons ltem1 lt0))
 (setq l3 (reverse l3))
)
(setq lt (append l3 lt))
 )
)

(defun dxf (code en)
 (cdr (assoc code en))
)

(defun pross (bp sp / tem ss n el ip lpt en pt en1 en2 en3 w dis ang
 di el1 el2 el3 pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8)
 (if (> (car bp) (car sp))
(setq tem bp bp sp sp tem)
 )
 (setq ss nil)
 (if (setq ss (ssget "c" bp sp))
(progn
 (setq n 0)
 (repeat (sslength ss)
(setq el (entget (setq en (ssname ss n))))
(if (and (= (dxf 0 el) "LINE")
 (or (= (dxf 8 el) "WALL") (= (dxf 8 el) "GWALL"))
 (setq ip (inters bp sp (dxf 10 el) (dxf 11 el)))
 ) ; ip 交点
 (progn
 (setq lpt (cons ip lpt))
 )
)
(setq n (1+ n))
 ) ; repeat 找出所有的交点并形成表lpt
 (if (/= nil lpt) (setq lpt (sort lpt)))
)
 )
 (if (> (length lpt) 2) (princ "\n警告:墙线有重线或选中了三条以上的墙线 !"))
 (if (< (length lpt) 2) (princ "\n警告:选中的墙线少于两条 !"))
 (if (/= nil lpt)
(progn
 (setq pt (car lpt))
 (setq ss (ssget pt))
 (setq en1 (ssname ss 0))
 (setq pt (cadr lpt))
 (setq ss nil)
 (setq ss (ssget pt))
 (setq en2 (ssname ss 0))
)
 )
 (setq en3 (car (entsel "\n选择左或下参考线(轴线和墙线均可)")))
 (setq el1 (entget en1))
 (setq el2 (entget en2))
 (setq el3 (entget en3))
 (setq ip nil)
 (setq ip (inters (dxf 10 el1) (dxf 11 el1) (dxf 10 el3) (dxf 11 el3) nil))

 (initget 6)
 (if (= nil dd) (setq dd 360.0))
 (setq dis (getdist ip (strcat "\n距参考点的距离 <" (rtos dd 2 0) ">:")))
 (if (= nil dis) (setq dis dd))
 (setq dd dis)

 (initget 6)
 (if (= nil ww) (setq ww 900.0))
 (setq w (getreal (strcat "\n门宽 <" (rtos ww 2 0) ">:")))
 (if (= nil w) (setq w ww))
 (setq ww w)

 (setq ang (angle (dxf 10 el1) (dxf 11 el1)))
 (if (>= ang 3.14159265) (setq ang (- ang pi)))
 (if (or (= ang pi) (= ang (* pi 2))) (setq ang 0))
 (setq di (distance (dxf 10 el1) (inters (dxf 10 el1) (polar (dxf 10 el1) (+ ang (* pi 0.5)) 100) (dxf 10 el2) (dxf 11 el2) nil)))
 (setq pt1 (polar ip ang dis))
 (setq pt2 (polar pt1 ang w))
 (command "break" en1 pt1 pt2)
 (setq pt3 (polar pt1 (+ ang (* pi 1.5)) di))
 (setq pt4 (polar pt3 ang w))
 (command "break" en2 pt3 pt4)
 (if (= (dxf 8 el) "GWALL")
(command "layer" "s" "gwall" "")
(command "layer" "s" "wall" "")
 )
 (command "line" pt1 pt3 "")
 (command "line" pt2 pt4 "")
 (command "layer" "s" "door" "")
 (if (> w 1000)
(progn
 (setq pt5 (polar pt1 (+ ang (* pi 1.5)) (/ di 2.0)))
 (setq pt6 (polar pt5 (+ ang (* pi 0.25)) (/ w 2)))
 (command "line" pt5 pt6 "")
 (setq pt5 (polar pt5 ang w))
 (setq pt6 (polar pt5 (+ ang (* pi 0.75)) (/ w 2)))
 (command "line" pt5 pt6 "")
)
(progn
 (setq pt5 (polar pt1 (+ ang (* pi 1.5)) (/ di 2.0)))
 (setq pt6 (polar pt5 (+ ang (* pi 0.25)) w))
 (command "line" pt5 pt6 "")
)
 )
)

;;;==============================================
;;; main programm
;;;==============================================

(defun C:door(/ bp sp)
 (setq old_err *error*)
 (setvar "CMDECHO" 0)
 (setvar "BLIPMODE" 0)
 (command "layer" "m" "door" "c" "g" "door" "")
 (command "osnap" "non")
 (setq bp (getpoint "\n第一点(注意:墙线应在第一点和第二点之间): "))
 (if (= nil bp) (quit))
 (if (= (getvar "orthomode") 0) (setvar "orthomode" 1))
 (setq sp (getpoint bp "\n第二点: "))
 (if (= nil sp) (quit))
 (pross bp sp)
 (princ)
)

kaiwen1000 · 发表于 2008-9-5 21:16:46

好东西，谢谢哦！

yoyoho · 发表于 2008-9-9 11:59:00

不錯!好程序!

coco25825 · 发表于 2008-12-9 15:38:15

不如用天正快

lyy · 发表于 2008-12-9 16:19:44

;;插入门窗
(defun doorwindow(sty / oldos pt val)
  (setvar "cmdecho" 0)
  (if (not door_h) (setq door_h 2100))
  (if (not door_w) (setq door_w 900))
  (if (not window_h) (setq window_h 1500))
  (if (not window_w) (setq window_w 1200))
  (vl-cmdf "_.layer" "_m" sty "_c" (if (= sty "门") "161" "91") "" "")
  (setq oldos (getvar "osmode"))
  (setvar "osmode" 512)
  (while (or (initget "H W")
         (setq pt (getpoint (strcat "\n***" sty "高=" (itoa (if (= sty "门") door_h window_h)) "、" sty "宽=" (itoa (if (= sty "门") door_w window_w)) "***\n点取墙体插入位置[高度(H)/宽度(W)]： ")))
      )
(cond
   ((= pt "H")
      (if (= sty "门")
      (setq door_h (if (and (setq val (getint "\n门高度：")) (/= (setq val (abs val)) 0)) val door_h))
      (setq window_h (if (and (setq val (getint "\n窗高度：")) (/= (setq val (abs val)) 0)) val window_h))
      )
   )
   ((= pt "W")
      (if (= sty "门")
      (setq door_w (if (and (setq val (getint "\n门宽度：")) (/= (setq val (abs val)) 0)) val door_w))
      (setq window_w (if (and (setq val (getint "\n窗宽度：")) (/= (setq val (abs val)) 0)) val window_w))
      )
   )
   (T
      (yad-adddoorwindow sty nil nil pt (if (= sty "门") door_w window_w) (if (= sty "门") door_h window_h) 1 sty)
   )
)
  )
  (setvar "osmode" oldos)
  (princ)
)
;;插入门
(defun c:door()(doorwindow "门"))
;;插入窗
(defun c:window()(doorwindow "窗"))

函数见：http://www.mjtd.com/bbs/dispbbs. ... ID=72471&page=1

拉契 · 发表于 2013-7-11 09:46:44

coco25825 发表于 2008-9-5 16:38
大家看我这个画门程序，未考证，据说能直接画门，并给出门的方向

怎么用的？提示错误...看来通用性不行！！

账号		自动登录	找回密码
密码			立即注册

[分享]：建筑图中画门(包括坡道),程序

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

点评