zengsijun 发表于 2007-10-19 20:22:00

求双线墙体绘制的LISP源程序

<p>我想要一个双线墙绘制的LISP源程序,要求,可以实现双线直墙与双线弧墙的切换,类似晓东工具箱\建荣工具箱里的墙线绘制工具!哪位高手能提供源码?本不不甚感激!!!</p>

szx025 发表于 2007-11-20 07:57:00

<p>;;;--------墙线----------</p><p>(defun C:WL (/ L1 L2 PT1 PT2 PT3 PT4 KU)</p><p>&nbsp;&nbsp;&nbsp; (if&nbsp;(setq L1 (getpoint "\nPick point:"))<br/>&nbsp;(progn<br/>&nbsp;&nbsp;&nbsp;&nbsp; (setq OLD_CMDECHO (getvar "CMDECHO"))<br/>&nbsp;&nbsp;&nbsp;&nbsp; (setvar "CMDECHO" 0)<br/>&nbsp;&nbsp;&nbsp;&nbsp; (setq CL (getvar "clayer"))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setvar "EDGEMODE" 1) <br/>&nbsp;&nbsp;&nbsp;&nbsp; (command "-layer" "m" "WALL" "C" "1" "" "")<br/>&nbsp;&nbsp;&nbsp;&nbsp; ;;PLINEWID 存储多段线的缺省宽度<br/>&nbsp;&nbsp;&nbsp;&nbsp; (setvar "PLINEWID" 60)<br/>&nbsp;&nbsp;&nbsp;&nbsp; (while (setq L2 (getpoint L1 "\nPick point:"))</p><p>&nbsp;&nbsp;(setq KU (angle L1 L2))<br/>&nbsp;&nbsp;(setq PT1 (polar L1 (+ KU (* 0.5 pi)) 120))<br/>&nbsp;&nbsp;(setq PT2 (polar L1 (+ KU (* 1.5 pi)) 120))<br/>&nbsp;&nbsp;(setq PT3 (polar L2 (+ KU (* 0.5 pi)) 120))<br/>&nbsp;&nbsp;(setq PT4 (polar L2 (+ KU (* 1.5 pi)) 120))</p><p>&nbsp;&nbsp;;;绘制<br/>&nbsp;&nbsp;(command "_.Pline" "non" PT1 "non" PT3 "")<br/>&nbsp;&nbsp;(setq ENT13 (entlast)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; S1&nbsp;&nbsp;&nbsp; (list ENT13 PT1)<br/>&nbsp;&nbsp;)<br/>&nbsp;&nbsp;(command "_.Pline" "non" PT2 "non" PT4 "")<br/>&nbsp;&nbsp;(setq ENT24 (entlast)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; S2&nbsp;&nbsp;&nbsp; (list ENT24 PT2)<br/>&nbsp;&nbsp;)</p><p>&nbsp;&nbsp;;;对上一交点处尝试进行修剪或延伸<br/>&nbsp;&nbsp;(if S3<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (progn<br/>&nbsp;&nbsp;&nbsp;(command "_.TRIM" S1 S3 "" S1 S3 "")<br/>&nbsp;&nbsp;&nbsp;(command "_.TRIM" S2 S4 "" S2 S4 "")<br/>&nbsp;&nbsp;&nbsp;(command "_.EXTEND" S1 S3 "" S1 S3 "")<br/>&nbsp;&nbsp;&nbsp;(command "_.EXTEND" S2 S4 "" S2 S4 "")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;)<br/>&nbsp;&nbsp;;;为下一段做准备<br/>&nbsp;&nbsp;(setq S3 (list ENT13 PT3)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; S4 (list ENT24 PT4)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; L1 L2<br/>&nbsp;&nbsp;)<br/>&nbsp;&nbsp;&nbsp;&nbsp; )</p><p></p><p>&nbsp;&nbsp;&nbsp;&nbsp; ;;图层名称应是字符串<br/>&nbsp;&nbsp;&nbsp;&nbsp; (setvar "clayer" CL)<br/>&nbsp;&nbsp;&nbsp;&nbsp; (setvar "CMDECHO" OLD_CMDECHO)<br/>&nbsp;)<br/>&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp; (princ)<br/>)</p>

fengsea 发表于 2007-12-23 14:30:00

<p>不能设定墙线的宽度，不好用！而且画完了不能闭合终端的线，改下会很方便的</p>

cxs259 发表于 2010-5-7 17:15:00

<p>看看这个</p><p>(defun c:dl()<br/>(if (= wwdy nil) (setq wwdy 240))<br/>(setq str1 (rtos wwdy 2 2))<br/>(prompt "\n&nbsp;&nbsp;now dline width is: ")<br/>(prompt str1)<br/>(setq pt1 (getpoint "\n enter start point:"))<br/>(setq pt2 (getpoint pt1 "\n enter next point:"))<br/>(setq dis1 (* 0.5 wwdy))<br/>(setq ag1 (angle pt1 pt2))<br/>(setq pt1u (polar pt1 (+ ag1 1.5708) dis1))<br/>(setq pt2u (polar pt2 (+ ag1 1.5708) dis1))<br/>(setq pt1d (polar pt1 (- ag1 1.5708) dis1))<br/>(setq pt2d (polar pt2 (- ag1 1.5708) dis1))<br/>(command "pline" "non" pt1u "non" pt2u "")<br/>(command "pline" "non" pt1d "non" pt2d "")<br/>(repeat 100<br/>&nbsp; &nbsp;(setq pt1 pt2)<br/>&nbsp; &nbsp;(setq pt2 (getpoint pt1 "\n enter next point:"))<br/>&nbsp; &nbsp;(setq dis1 (* 0.5 wwdy))<br/>&nbsp; &nbsp;(setq ag1 (angle pt1 pt2))<br/>&nbsp; &nbsp;(setq pt1u (polar pt1 (+ ag1 1.5708) dis1))<br/>&nbsp; &nbsp;(setq pt2u (polar pt2 (+ ag1 1.5708) dis1))<br/>&nbsp; &nbsp;(setq pt1d (polar pt1 (- ag1 1.5708) dis1))<br/>&nbsp; &nbsp;(setq pt2d (polar pt2 (- ag1 1.5708) dis1))<br/>&nbsp; &nbsp;(command "pline" "non" pt1u "non" pt2u "")<br/>&nbsp; &nbsp;(command "pline" "non" pt1d "non" pt2d "")<br/>)<br/>)</p>

tianyi1230 发表于 2012-10-8 21:50:27

默认为240墙线了

lxy_2080 发表于 2014-3-22 22:43:01

好像挺好，留记号，明天电脑试下
页: [1]
查看完整版本: 求双线墙体绘制的LISP源程序