[编程申请]：自动标立面、剖面的标高的小程序
<FONT face=宋体 size=2>最近做一个20多层的建筑，发现标立面剖面的标高真是个大工程，可不可以请高手做一个小程序，可以输入层高、层数等参数后，可自动生成标高，点插入点然后各标高就在自己所标注高度的位置……</FONT><FONT face=宋体 size=2>像这样的</FONT>
http://p4.xdcad.net/forum/file_upload/206574_untitled-1%20copy.jpg
<FONT face=宋体 size=2>谢谢大家了</FONT> 方法：将压缩文件中的“$bg.dwg”放到路径下，加载lpmbg.lsp程序，运行lpmbg。
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<BR>;;;lpmbg.lsp 立剖面标高<BR>;;;* C:LPMBG<BR>;;;-- <A href="mailto:XYP@bsedi.com" target="_blank" >XYP@bsedi.com</A><BR>;;;2004.07.31<BR>;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<BR>(prompt "\n\r 加载立剖面标高程序。")<BR>;-------------------------------------------<BR>;;;主程序<BR>(DEFUN C:LPMBG (/ pt0 x0 y0 y n)<BR> (CMDLA0)<BR> (setvar "osmode"39)<BR> (MKLA "立剖面标高" 3)<BR> (WHILE (NOT (SETQ pt0 (getpoint "\n\t确定±0.000标高位置点 : "))))<BR> (setq H-ceng (ureal 1 "" "层高（m）" h-ceng))<BR> (setq n-ceng (ureal 1 "" "层数" n-ceng))<BR> (setvar "osmode"0)<BR> (command "ucs" "o" pt0)<BR> (setq y0 0 n 0 pt0 (list 0 0))<BR> (while (< n (+ 1 n-ceng))<BR> (setq y (* (/ y0 1000.0) (GETVAR "DIMLFAC"))<BR> y (rtos y 2 3)<BR> )<BR> (if (= y0 0)<BR> (command "INSERT" "$BG" pt0 SC SC "0" "±0.000");$BG为标高图块，可以自定义<BR> (command "INSERT" "$BG" pt0 SC SC "0" y)<BR> )<BR> (setq n (+ 1 n))<BR> (setq y0 (* n 1000.0 h-ceng))<BR> (setq pt0 (list 0 y0))<BR> )<BR> (command "ucs" "")<BR> (CMDLA1)<BR> (pxyp"lpmbg (立剖面标高)")<BR> )
;;;-------------------------------------------<BR>;;;子程序<BR>;;;<BR>(defun CMDLA0 ()<BR> (setq cmdech (GETVAR "CMDECHO"))<BR> (setq oom (getvar "orthomode"))<BR> (setq osm (getvar "osmode"))<BR> (SETQ LA (getvar "clayer"))<BR> (setvar "regenmode" 1)<BR> (SETVAR "CMDECHO" 0)<BR> )
;;;<BR>(defun CMDLA1 ()<BR> (SETVAR "CMDECHO" cmdech)<BR> (setvar "orthomode" oom)<BR> (setvar "osmode" osm)<BR> (setvar "clayer" LA)<BR> (setvar "regenmode" 1)<BR> )
;;;<BR>(defun ureal (bit kwd msg def / inp)<BR> (if def<BR> (setq msg (strcat "\n" msg "<" (rtos def 2) ">: ")<BR> bit (* 2 (fix (/ bit 2)))<BR> )<BR> (setq msg (strcat "\n" msg ": "))<BR> )<BR> (initget bit kwd)<BR> (setq inp (getreal msg))<BR> (if inp inp def)<BR> )
;;;<BR>(Defun MKLA (a b)<BR> (If (= (Tblsearch "layer" a) nil)<BR> (Command "layer" "m" a "c" b a "")<BR> (Command "layer" "t" a "s" a "c" b a "")<BR> )<BR> )
;;;<BR>(DEFUN PXYP (TXT1)<BR> (SETQ TXT1 (STRCAT "\n\r 程序命令: " TXT1 " -- <A href="mailto:XYP@bsedi.com" target="_blank" >XYP@bsedi.com</A>"))<BR> (PRINC TXT1)<BR> (Princ)<BR> );defun
;;;<BR>(pxyp"lpmbg (立剖面标高)")
;-------------------------------------------<BR>;;;END
真得很好用啊谢谢 有点意思啊 有点感觉，呵呵 有点意思啊 xyp1964 发表于 2004-7-31 15:18
方法：将压缩文件中的“$bg.dwg”放到路径下，加载lpmbg.lsp程序，运行lpmbg。
确定±0.000标高位置点 :
层高（m）<3.00>:
层数<3.00>:
未知命令“0”。按 F1 查看帮助。
未知命令“±0.000”。按 F1 查看帮助。
未知命令“0”。按 F1 查看帮助。
未知命令“3.000”。按 F1 查看帮助。
未知命令“0”。按 F1 查看帮助。
未知命令“6.000”。按 F1 查看帮助。
未知命令“0”。按 F1 查看帮助。
未知命令“9.000”。按 F1 查看帮助。 私信我, 了解详细需求后, 用高级语言实现.{:1_1:}
页:
[1]