★★★★★【AEC自定义实体的Vlisp编程函数】★★★★★

lyy

*** AEC门窗墙编程函数(For AutoCAD2005~2009) ***
                        2008.12.17

1、创建墙体---返回墙体实体名
  (yad-addwall style hatch scale color spt ept mpt width high align note layer)
   style  “直墙”或“弧墙”
   hatch  墙体填充名称或nil
   scale  填充比例或nil
   color  填充颜色或nil
   spt    墙体起点
   ept    墙体终点
   mpt    弧墙第二点或nil
   width  墙体厚度
   high   墙体高度
   align  墙线对齐[0左墙线 1墙中线 2右墙线]
   note   墙体材料注释
   layer  图层名称
如：(yad-addwall "直墙" "ANSI31" 20 252 (getpoint) (getpoint) nil 200 3000 1 "砖" "墙")

2、创建门窗---返回门窗实体名
  (yad-adddoorwindow style block scale ipt width high open note layer)
   style  “门”或“窗”
   block  门窗图块名称或nil
   scale  图块比例方式或nil[0自动适合墙厚 1保持长宽比]
   ipt    门窗插入位置
   width  门窗宽度
   high   门窗高度
   open   开启方向[1或2或3或4]
   note   门窗材料注释
   layer  图层名称
如：(yad-adddoorwindow "门" nil nil (getpoint) 900 2100 1 "铝合金" "门")

3、获取门窗墙属性---返回所有属性列表[属性参考上面的创建函数]
  (yad-getarchval ent)
   ent    门窗墙对象实体
如：(yad-getarchval (car (entsel)))

4、更改门窗墙属性---返回实体名
  (yad-putarchval ent lst val)
   ent    门窗墙对象实体
   lst    属性列表[属性参考上面的创建函数]
   val    对应属性的新值列表
如：(yad-putarchval (car (entsel)) '("hatch" "width" "high") '("solid" 240 3600))

5、获取门窗所在的墙体对象---返回实体名
  (yad-getwall ent)
   ent-门窗对象实体
如：(yad-getwall (car (entsel)))

6、获取墙体上的门窗对象---返回选择集
  (yad-getdoorwindow wall key)
   wall-墙体对象实体或墙体选择集
   key-要获取的对象[0门 1窗 2门窗]
如：(yad-getdoorwindow (car (entsel)) 2)  

tumu2008323

请问 有 yad-addwall 这个函数吗？

pengfei2010

感谢楼主的无私分享 谢谢

尘缘一生

顶起来，可惜缺少函数

lyy

;;
;; ***** 门窗墙函数开发的示例程序 *****
;;
;;
;;加载YAD门窗墙函数
(if (not yad-addwall) (load "yadarch"))
;;画墙
(defun c:wall(/ lay oldort pt1 pt2 val)
  (setvar "cmdecho" 0)
  (if (not wall_h) (setq wall_h 3000))
  (if (not wall_w) (setq wall_w 200))
  (if (not wall_sty) (setq wall_sty "直墙"))
  (vl-cmdf "_.layer" "_m" (setq lay "墙") "_c" "41" "" "")
  (setq oldort (getvar "orthomode"))
  (while (or (initget "H W S") (setq pt1 (getpoint (strcat "\n***" wall_sty "、墙高=" (itoa wall_h) "、墙厚=" (itoa wall_w) "***\n" wall_sty "起点[墙高(H)/墙厚(W)/形式(S)]： "))))
    (cond
      ((= pt1 "H")
        (setq wall_h (if (and (setq val (getint "\n墙体高度：")) (/= (setq val (abs val)) 0)) val wall_h))
      )
      ((= pt1 "W")
        (setq wall_w (if (and (setq val (getint "\n墙体厚度：")) (/= (setq val (abs val)) 0)) val wall_w))
      )
      ((= pt1 "S")
        (initget "L A")
        (setq val (getkword (strcat "\n选择墙体形式[直墙(L)/弧墙(A)]：<" (if (= wall_sty "直墙") "L" "A") ">")))
        (if val (setq wall_sty (if (= val "L") "直墙" "弧墙")))
      )
      ((= wall_sty "直墙")
        (setvar "orthomode" oldort)
        (while (setq pt2 (getpoint pt1 "\n直墙下一点："))
          (yad-addwall wall_sty nil nil nil pt1 pt2 nil wall_w wall_h 1 "砖" lay)
          (setq pt1 pt2)
        )
      )
      (T
        (setvar "orthomode" 0)
        (while (and (setq pt2 (getpoint pt1 "\n弧墙终点："))
                    (not (grdraw pt1 pt2 1 1))
                    (setq pt3 (getpoint (polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2)) "\n弧墙上的第二点："))
               )
          (yad-addwall wall_sty "ansi31" 20 252 pt1 pt2 pt3 wall_w wall_h 1 "砖" lay)
          (setq pt1 pt2)
          (redraw)
        )
        (redraw)
      )
    )
  )
  (setvar "orthomode" oldort)
  (princ)
)
;;移动墙体端点
(defun c:wallpt(/ ent pt lst spt ept mpt pt1 sty)
  (while (and (setq ent (entsel "\n点取墙体端点：")) (setq pt (cadr ent) ent (car ent)))
    (if (= (cdr (assoc 0 (entget ent))) "AEC_WALL")
      (progn
        (setq lst (yad-getarchval ent) spt (cadr (assoc "spt" lst)) ept (cadr (assoc "ept" lst)) mpt (cadr (assoc "mpt" lst)))
        (if (> (distance ept pt) (distance spt pt))
          (setq pt1 spt sty "spt")
          (setq pt1 ept sty "ept")
        )
        (if (and mpt (> (distance pt pt1) (distance pt mpt)))
          (setq pt1 mpt sty "mpt")
        )
        (if (setq pt (getpoint pt1 (strcat "\n点取墙体" (cdr (assoc sty '(("spt" . "起点")("ept" . "终点")("mpt" . "中点")))) "的移动位置：")))
          (yad-putarchval ent (list sty) (list pt))
        )
      )
      (prompt "\n不是墙体！")
    )
  )
  (princ)
)
;;墙线对齐切换
(defun c:wallalign(/ ent lst align)
  (while (and (setq ent (entsel "\n点取墙体：")) (setq ent (car ent)))
    (if (= (cdr (assoc 0 (entget ent))) "AEC_WALL")
      (progn
        (setq lst (yad-getarchval ent) align (cadr (assoc "align" lst)))
        (yad-putarchval ent '("align") (list (rem (1+ align) 3)))
      )
      (prompt "\n不是墙体！")
    )
  )
  (princ)
)
;;墙体填充切换
(defun c:wallhatch(/ ent lst align)
  (while (and (setq ent (entsel "\n点取墙体：")) (setq ent (car ent)))
    (if (= (cdr (assoc 0 (entget ent))) "AEC_WALL")
      (progn
        (setq lst (yad-getarchval ent) hatch (cadr (assoc "hatch" lst)))
        (cond
          ((= hatch "solid") (setq hatch "ansi31"))
          ((= hatch "ansi31") (setq hatch nil))
          (T (setq hatch "solid"))
        )
        (yad-putarchval ent '("hatch") (list hatch))
      )
      (prompt "\n不是墙体！")
    )
  )
  (princ)
)
;;插入门窗
(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 "窗"))
;;门窗翻转
(defun mirdoorwindow(sty / ent lst open)
  (while (and (setq ent (entsel "\n点取要翻转的门窗：")) (setq ent (car ent)))
    (if (wcmatch (cdr (assoc 0 (entget ent))) "AEC_DOOR,AEC_WINDOW")
      (progn
        (setq lst (yad-getarchval ent) open (cadr (assoc "open" lst)))
        (cond
          ((= open 1) (setq open (if (= sty 0) 2 4)))
          ((= open 2) (setq open (if (= sty 0) 1 3)))
          ((= open 3) (setq open (if (= sty 0) 4 2)))
          ((= open 4) (setq open (if (= sty 0) 3 1)))
          (T)
        )
        (yad-putarchval ent '("open") (list open))
      )
      (prompt "\n不是门窗！")
    )
  )
  (princ)
)
;;左右翻转
(defun c:mirlr() (mirdoorwindow 0))
;;内外翻转
(defun c:mirio() (mirdoorwindow 1))

artken

高手。厉害

只是不方便编辑

zdarc

很有意思， 希望开发更多函数。不明白为什么2004不能使用？

lyy

artken发表于2008-12-9 16:33:00高手。厉害只是不方便编辑

yad-getarchval和yad-putarchval和你的编程足够编辑了！

lyy

zdarc发表于2008-12-9 23:35:00很有意思， 希望开发更多函数。不明白为什么2004不能使用？

For AutoCAD2005~2009

更多的功能由你开发，yad-getarchval和yad-putarchval两个函数就够了！

lyy

增加了几个属性参数，重新下载吧！

它山之石

命令: wall

***直墙、墙高=3000、墙厚=200***
直墙起点[墙高(H)/墙厚(W)/形式(S)]：
直墙下一点：
错误: 参数类型错误: lentityp nil

简版2004

露水2

有意思

carrot1983

它山之石发表于2008-12-10 12:45:00命令: wall***直墙、墙高=3000、墙厚=200***直墙起点：直墙下一点：错误: 参数类型错误: lentityp nil简版2004

(For AutoCAD 2005~2009) *****