[LISP] 寻求AUTOLISP图元体与群码表的详细分析资料 谢谢

zhongguola

诸位大哥：

我刚开始学AUTOLISP，需要AUTOLISP图元体与群码表的详细分析资料，哪位大哥能帮帮我吗？

谢了！！！

zhongguola

请问：no function definition: UREAL是什么意思呀？

zhongguola

以上问题是我在运行以下程序时出现的。

;|
ztmj.lsp 总图面积
* C:ztmj
-- xyp@bsedi.com
2004.09.30
|;
(prompt "\n\r      加载总图面积程序。")
;;;-------------------------------------------
;;;主程序
(defun c:ztmj (/ pt pt1 en aa bl-bz)
  (cmdla0)
  (princ "\n注意绘图单位 : 1＝1米")
  (SETBL1)
  (setq h (* SC 300))
  (COMMAND "style" "宋体" "宋体" h "0.7" "0" "" "")
  (initget "A B C")
  (setq
    BL-bz (getkword "\n请选择标注单位 A-平方米/B-亩/C-公顷.<平方米>:")
  )
  (initget "Y N")
  (setq bz2 (getkword "需要标注单位名称吗?Y/<N>"))
  (setq pt (getpoint "\n选取封闭域内一点: "))
  (while pt
    (setq pt1 pt)
    (mkla "封闭域辅助线" 8)
    (command "bpoly" pt "")
    (setq en (entlast))
    (if (/= en nil)
      (progn
 (command "area" "o" en)
 (setq aa (getvar "area"))
 ;;(redraw en 3)
 ;|1标准2空白3高亮4低亮
 此句可以显示面积数（单位平方米）
 如果是总图或测量专业，画图单位为米时，下句中1000000.0应改为1.0
 (alert (strcat "面积=" (rtos (/ aa 1000000.0) 2 2)))
 |;
      )
    )
    (entdel en)
    ;;此句可以决定是否删除“封闭域辅助线”
    (mkla "面积标注" 4)
    (setq bz2 (if bz2
  bz2
  "N"
       )
    )
    (if (= bz2 "N")
      (progn
 (setq BL-bz (if BL-bz
        BL-bz
        "A"
      )
 )
 (if (= bl-bz "A")
   (setq aa (rtos (/ aa 1.0) 2 2))
 )
 (if (= bl-bz "B")
   (setq aa (rtos (/ aa (/ 2000.0 3)) 2 2))
 )
 (if (= bl-bz "C")
   (setq aa (rtos (/ aa 10000.0) 2 4))
 )
      )
      (progn
 (setq BL-bz (if BL-bz
        BL-bz
        "A"
      )
 )
 (if (= bl-bz "A")
   (setq aa (strcat (rtos (/ aa 1.0) 2 2) "平方米"))
 )
 (if (= bl-bz "B")
   (setq aa (strcat (rtos (/ aa (/ 2000.0 3)) 2 2) "亩"))
 )
 (if (= bl-bz "C")
   (setq aa (strcat (rtos (/ aa 10000.0) 2 4) "公顷"))
 )
      )
    )
    (command "text" "j" "mc" pt1 "0" aa)
    (setq pt (getpoint "\n选取封闭域内一点: "))
  )
  (cmdla1)
  ;;(pxyp"ztmj      (总图面积)")
)

;;;-------------------------------------------
;;;子程序
;;;
(defun CMDLA0 ()
  (setq cmdech (getvar "CMDECHO"))
  (setq oom (getvar "orthomode"))
  (setq osm (getvar "osmode"))
  (SETQ LA (getvar "clayer"))
  (setq rmode (getvar "regenmode"))
  (setvar "regenmode" 0)
  (setvar "CMDECHO" 0)
  (princ)
)

;;;
(defun CMDLA1 ()
  (setvar "CMDECHO" cmdech)
  (setvar "orthomode" oom)
  (setvar "osmode" osm)
  (setvar "clayer" LA)
  (setvar "regenmode" rmode)
  (princ)
)

;;;
(Defun MKLA (a b)
  (If (= (Tblsearch "layer" a) nil)
    (Command "layer" "m" a "c" b a "")
    (Command "layer" "t" a "s" a "c" b a "")
  )
)

;;;* SET BL & SC. 设置总图出图比例及比例系数。
(defun setbl1 ()
  ;;(while (OR (= BL NIL) (> bl 3))
  ;;(GRTEXT -1 "总图以米为单位, 请注意!!!" 1)
  ;;(setq bl (ureal 1 ""  "\n\t输入出图比例1 " bl))
  ;;)
  (setq bl (ureal 1 "" "\n输入出图比例1 : " bl))
  (setq SC (/ bl 100))
  (command "modemacro"
    (strcat "XCAD BY XYP." " 当前出图比例 1:" (rtos bl 2 1))
  )
)

;;;
(DEFUN Pxyp (TXT1)
  (SETQ TXT1 (STRCAT "\n\r      程序命令: "
       TXT1
       "      -- xyp@bsedi.com"
      )
  )
  (PRINC TXT1)
  (Princ)
)
;;;defun

;;;
(pxyp "ztmj      (总图面积)")
(princ)
;;;-------------------------------------------
;;;END

xuefeng032

兄弟，在程序中这一句“ (setq bl (ureal 1 "" "\n输入出图比例1 : " bl))”

ureal该函数名未定义

 

Andyhon

    ;* UREAL User interface real function
    ;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET.
    ;* MSG is the prompt string, to which a default real is added as <DEF> (nil
    ;* for none), and a : is added.
    ;*
    (defun ureal (bit kwd msg def / inp)
       (if def                                                  ;test for a default
         (setq msg (strcat "\n >> " msg " < " (rtos def 2) " >: ")     ;string'em with default
               bit (* 2 (fix (/ bit 2)))  ;a default & no null bit code conflict so
         )                                ;this reduces bit by 1 if odd, to allow null
         (if (= " " (substr msg (strlen msg) 1))            ;no def, if last char is space
           (setq msg (strcat "\n >> " (substr msg 1 (1- (strlen msg))) " : ")) ;then strip space
           (setq msg (strcat "\n >> " msg " : "))                ;else msg OK
       ) );if,if
       (initget bit kwd)
       (setq inp (getreal msg))           ;the GETREAL function
       (if inp inp def)                   ;compare the results, return appropriate value
    );defun
    ;*

zhongguola

谢谢各位大哥相助！！！

请问有AUTOLISP图元体与群码表的详细分析资料吗？   谢谢

andyamy

下载完，请帮忙顶一下。

http://www.xdcad.net/forum/showthread.php?s=&threadid=438868

zhongguola

大哥呀大哥，求你饶了小弟吧。那是一个收费网站，要了小弟的命我也没钱啊！！！

zhongguola

诸位大哥救我呀！！！

mccad

http://www.mjtd.com/mcdown/list.asp?id=419