★★★★★【AEC自定义实体的Vlisp编程函数】★★★★★
本帖最后由 lyy 于 2025-3-18 21:57 编辑 <br /><br /> <p>*** AEC门窗墙编程函数(For AutoCAD2005~2009) ***<br/> 2008.12.17</p><p>1、创建墙体---返回墙体实体名<br/> (yad-addwall style hatch scale color spt ept mpt width high align note layer)<br/> style “直墙”或“弧墙”<br/> hatch 墙体填充名称或nil<br/> scale 填充比例或nil<br/> color 填充颜色或nil<br/> spt 墙体起点<br/> ept 墙体终点<br/> mpt 弧墙第二点或nil<br/> width 墙体厚度<br/> high 墙体高度<br/> align 墙线对齐<br/> note 墙体材料注释<br/> layer 图层名称<br/>如：(yad-addwall "直墙" "ANSI31" 20 252 (getpoint) (getpoint) nil 200 3000 1 "砖" "墙")</p><p>2、创建门窗---返回门窗实体名<br/> (yad-adddoorwindow style block scale ipt width high open note layer)<br/> style “门”或“窗”<br/> block 门窗图块名称或nil<br/> scale 图块比例方式或nil<br/> ipt 门窗插入位置<br/> width 门窗宽度<br/> high 门窗高度<br/> open 开启方向<br/> note 门窗材料注释<br/> layer 图层名称<br/>如：(yad-adddoorwindow "门" nil nil (getpoint) 900 2100 1 "铝合金" "门")</p><p>3、获取门窗墙属性---返回所有属性列表[属性参考上面的创建函数]<br/> (yad-getarchval ent)<br/> ent 门窗墙对象实体<br/>如：(yad-getarchval (car (entsel)))</p><p>4、更改门窗墙属性---返回实体名<br/> (yad-putarchval ent lst val)<br/> ent 门窗墙对象实体<br/> lst 属性列表[属性参考上面的创建函数]<br/> val 对应属性的新值列表<br/>如：(yad-putarchval (car (entsel)) '("hatch" "width" "high") '("solid" 240 3600))</p><p>5、获取门窗所在的墙体对象---返回实体名<br/> (yad-getwall ent)<br/> ent-门窗对象实体<br/>如：(yad-getwall (car (entsel)))</p><p>6、获取墙体上的门窗对象---返回选择集<br/> (yad-getdoorwindow wall key)<br/> wall-墙体对象实体或墙体选择集<br/> key-要获取的对象<br/>如：(yad-getdoorwindow (car (entsel)) 2) </p> 本帖最后由 lyy 于 2025-4-7 10:39 编辑 <br /><br />liminnet发表于2008-12-10 17:41:00static/image/common/back.gif强。。。。。。。。。。。。。。。。。。。。。。。呀，看来天正建筑要完蛋啦，<p>呵呵！天正建筑不会完蛋的．</p> 本帖最后由 lyy 于 2025-4-7 10:38 编辑 <br /><br />露水2发表于2008-12-10 13:21:00static/image/common/back.gif全是lisp写的吗
<p></p>是vlisp写的 请问 有 yad-addwall 这个函数吗？ 本帖最后由 作者 于 2008-12-10 17:59:35 编辑 <br /><br /> <p>;;<br/>;; ***** 门窗墙函数开发的示例程序 *****<br/>;;<br/>;;<br/>;;加载YAD门窗墙函数<br/>(if (not yad-addwall) (load "yadarch"))<br/>;;画墙<br/>(defun c:wall(/ lay oldort pt1 pt2 val)<br/> (setvar "cmdecho" 0)<br/> (if (not wall_h) (setq wall_h 3000))<br/> (if (not wall_w) (setq wall_w 200))<br/> (if (not wall_sty) (setq wall_sty "直墙"))<br/> (vl-cmdf "_.layer" "_m" (setq lay "墙") "_c" "41" "" "")<br/> (setq oldort (getvar "orthomode"))<br/> (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)]： "))))<br/> (cond<br/> ((= pt1 "H")<br/> (setq wall_h (if (and (setq val (getint "\n墙体高度：")) (/= (setq val (abs val)) 0)) val wall_h))<br/> )<br/> ((= pt1 "W")<br/> (setq wall_w (if (and (setq val (getint "\n墙体厚度：")) (/= (setq val (abs val)) 0)) val wall_w))<br/> )<br/> ((= pt1 "S")<br/> (initget "L A")<br/> (setq val (getkword (strcat "\n选择墙体形式[直墙(L)/弧墙(A)]：<" (if (= wall_sty "直墙") "L" "A") ">")))<br/> (if val (setq wall_sty (if (= val "L") "直墙" "弧墙")))<br/> )<br/> ((= wall_sty "直墙")<br/> (setvar "orthomode" oldort)<br/> (while (setq pt2 (getpoint pt1 "\n直墙下一点："))<br/> (yad-addwall wall_sty nil nil nil pt1 pt2 nil wall_w wall_h 1 "砖" lay)<br/> (setq pt1 pt2)<br/> )<br/> )<br/> (T<br/> (setvar "orthomode" 0)<br/> (while (and (setq pt2 (getpoint pt1 "\n弧墙终点："))<br/> (not (grdraw pt1 pt2 1 1))<br/> (setq pt3 (getpoint (polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2)) "\n弧墙上的第二点："))<br/> )<br/> (yad-addwall wall_sty "ansi31" 20 252 pt1 pt2 pt3 wall_w wall_h 1 "砖" lay)<br/> (setq pt1 pt2)<br/> (redraw)<br/> )<br/> (redraw)<br/> )<br/> )<br/> )<br/> (setvar "orthomode" oldort)<br/> (princ)<br/>)<br/>;;移动墙体端点<br/>(defun c:wallpt(/ ent pt lst spt ept mpt pt1 sty)<br/> (while (and (setq ent (entsel "\n点取墙体端点：")) (setq pt (cadr ent) ent (car ent)))<br/> (if (= (cdr (assoc 0 (entget ent))) "AEC_WALL")<br/> (progn<br/> (setq lst (yad-getarchval ent) spt (cadr (assoc "spt" lst)) ept (cadr (assoc "ept" lst)) mpt (cadr (assoc "mpt" lst)))<br/> (if (> (distance ept pt) (distance spt pt))<br/> (setq pt1 spt sty "spt")<br/> (setq pt1 ept sty "ept")<br/> )<br/> (if (and mpt (> (distance pt pt1) (distance pt mpt)))<br/> (setq pt1 mpt sty "mpt")<br/> )<br/> (if (setq pt (getpoint pt1 (strcat "\n点取墙体" (cdr (assoc sty '(("spt" . "起点")("ept" . "终点")("mpt" . "中点")))) "的移动位置：")))<br/> (yad-putarchval ent (list sty) (list pt))<br/> )<br/> )<br/> (prompt "\n不是墙体！")<br/> )<br/> )<br/> (princ)<br/>)<br/>;;墙线对齐切换<br/>(defun c:wallalign(/ ent lst align)<br/> (while (and (setq ent (entsel "\n点取墙体：")) (setq ent (car ent)))<br/> (if (= (cdr (assoc 0 (entget ent))) "AEC_WALL")<br/> (progn<br/> (setq lst (yad-getarchval ent) align (cadr (assoc "align" lst)))<br/> (yad-putarchval ent '("align") (list (rem (1+ align) 3)))<br/> )<br/> (prompt "\n不是墙体！")<br/> )<br/> )<br/> (princ)<br/>)<br/>;;墙体填充切换<br/>(defun c:wallhatch(/ ent lst align)<br/> (while (and (setq ent (entsel "\n点取墙体：")) (setq ent (car ent)))<br/> (if (= (cdr (assoc 0 (entget ent))) "AEC_WALL")<br/> (progn<br/> (setq lst (yad-getarchval ent) hatch (cadr (assoc "hatch" lst)))<br/> (cond<br/> ((= hatch "solid") (setq hatch "ansi31"))<br/> ((= hatch "ansi31") (setq hatch nil))<br/> (T (setq hatch "solid"))<br/> )<br/> (yad-putarchval ent '("hatch") (list hatch))<br/> )<br/> (prompt "\n不是墙体！")<br/> )<br/> )<br/> (princ)<br/>)<br/>;;插入门窗<br/>(defun doorwindow(sty / oldos pt val)<br/> (setvar "cmdecho" 0)<br/> (if (not door_h) (setq door_h 2100))<br/> (if (not door_w) (setq door_w 900))<br/> (if (not window_h) (setq window_h 1500))<br/> (if (not window_w) (setq window_w 1200))<br/> (vl-cmdf "_.layer" "_m" sty "_c" (if (= sty "门") "161" "91") "" "")<br/> (setq oldos (getvar "osmode"))<br/> (setvar "osmode" 512)<br/> (while (or (initget "H W")<br/> (setq pt (getpoint (strcat "\n***" sty "高=" (itoa (if (= sty "门") door_h window_h)) "、" sty "宽=" (itoa (if (= sty "门") door_w window_w)) "***\n点取墙体插入位置[高度(H)/宽度(W)]： ")))<br/> )<br/> (cond<br/> ((= pt "H")<br/> (if (= sty "门")<br/> (setq door_h (if (and (setq val (getint "\n门高度：")) (/= (setq val (abs val)) 0)) val door_h))<br/> (setq window_h (if (and (setq val (getint "\n窗高度：")) (/= (setq val (abs val)) 0)) val window_h))<br/> )<br/> )<br/> ((= pt "W")<br/> (if (= sty "门")<br/> (setq door_w (if (and (setq val (getint "\n门宽度：")) (/= (setq val (abs val)) 0)) val door_w))<br/> (setq window_w (if (and (setq val (getint "\n窗宽度：")) (/= (setq val (abs val)) 0)) val window_w))<br/> )<br/> )<br/> (T<br/> (yad-adddoorwindow sty nil nil pt (if (= sty "门") door_w window_w) (if (= sty "门") door_h window_h) 1 "铝合金" sty)<br/> )<br/> )<br/> )<br/> (setvar "osmode" oldos)<br/> (princ)<br/>)<br/>;;插入门<br/>(defun c:door()(doorwindow "门"))<br/>;;插入窗<br/>(defun c:window()(doorwindow "窗"))<br/>;;门窗翻转<br/>(defun mirdoorwindow(sty / ent lst open)<br/> (while (and (setq ent (entsel "\n点取要翻转的门窗：")) (setq ent (car ent)))<br/> (if (wcmatch (cdr (assoc 0 (entget ent))) "AEC_DOOR,AEC_WINDOW")<br/> (progn<br/> (setq lst (yad-getarchval ent) open (cadr (assoc "open" lst)))<br/> (cond<br/> ((= open 1) (setq open (if (= sty 0) 2 4)))<br/> ((= open 2) (setq open (if (= sty 0) 1 3)))<br/> ((= open 3) (setq open (if (= sty 0) 4 2)))<br/> ((= open 4) (setq open (if (= sty 0) 3 1)))<br/> (T)<br/> )<br/> (yad-putarchval ent '("open") (list open))<br/> )<br/> (prompt "\n不是门窗！")<br/> )<br/> )<br/> (princ)<br/>)<br/>;;左右翻转<br/>(defun c:mirlr() (mirdoorwindow 0))<br/>;;内外翻转<br/>(defun c:mirio() (mirdoorwindow 1))</p> <p>高手。厉害</p><p></p><p>只是不方便编辑</p> 很有意思， 希望开发更多函数。不明白为什么2004不能使用？ artken发表于2008-12-9 16:33:00static/image/common/back.gif高手。厉害只是不方便编辑
<p>yad-getarchval和yad-putarchval和你的编程足够编辑了！</p> zdarc发表于2008-12-9 23:35:00static/image/common/back.gif很有意思， 希望开发更多函数。不明白为什么2004不能使用？
<p>For AutoCAD2005~2009</p><p>更多的功能由你开发，yad-getarchval和yad-putarchval两个函数就够了！</p> 增加了几个属性参数，重新下载吧！ <p>命令: wall</p><p>***直墙、墙高=3000、墙厚=200***<br/>直墙起点[墙高(H)/墙厚(W)/形式(S)]：<br/>直墙下一点：<br/>错误: 参数类型错误: lentityp nil</p><p></p><p></p><p>简版2004</p> 有意思 它山之石发表于2008-12-10 12:45:00static/image/common/back.gif命令: wall***直墙、墙高=3000、墙厚=200***直墙起点：直墙下一点：错误: 参数类型错误: lentityp nil简版2004
<p>(For AutoCAD 2005~2009) *****</p>