找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 680|回复: 0

[LISP函数]:请教高手指点(贴源码)

[复制链接]
发表于 2006-5-25 15:34:53 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
请教高手这个程序错在那里!请帮忙修改!
(defun pst(b)
   (cdr(assoc 10 b))
)

(defun pen(b)
   (cdr(assoc 11 b))
)

(defun perp(pt1 pt2 pt3)
     (inters pt1 (polar pt1 (+ (angle pt2 pt3) (/ pi 2)) 0.01) pt2 pt3 nil)
)

(defun inl1()
    (setq lx nil l1 nil)
  (   
    while (/= "LINE" (cdr (assoc 0 l1)))
     (setq l1 nil lx nil)
   (
    while (= lx nil)
    (setq lx(car (entsel "\nPlease choose a boundary of a segment of the route:")))
   )
    (setq l1(entget lx))
  )
    (setq pa1(pst l1))
    (setq pa2(pen l1))
)

(defun inl2()
  (setq l2 nil lt nil)  
  (
  while (/= "LINE" (cdr (assoc 0 l2)))   
    (setq l2 nil lt nil)
  (
   while (= lt nil)  
   (setq lt(car (entsel "\nPlease choose another boundary of segment of the route:")))
  )
    (setq l2(entget lt))
  )
    (setq pb1(pst l2))
    (setq pb2(pen l2))  
)

(defun iput()
    (inl1)
    (command "line" pa1 pa2 "")
    (ssadd (entlast) ss)
    (setq pb1 pa1)
    (while (or (equal pa1 pb1) (equal pa1 pb2) (equal pa2 pb1) (equal pa2 pb2))   
     (inl2)
    )
    (command "line" pb1 pb2 "")
    (ssadd (entlast) ss)
  (setq l1(distance pa1 pa2))
  (setq l2(distance pb1 pb2))
)

(defun itsl1()
     (setq perp1(perp pa1 pb1 pb2))
     (setq perp2(perp pa2 pb1 pb2))
     (setq top(distance pa1 perp1))
     (setq bot(distance pa2 perp2))
     (setq l(distance perp1 perp2))
)

(defun itsl2()
     (setq perp1(perp pb1 pa1 pa2))
     (setq perp2(perp pb2 pa1 pa2))
     (setq top(distance pb1 perp1))
     (setq bot(distance pb2 perp2))
     (setq l(distance perp1 perp2))
)

(defun compare()
  (if (< l1 l2)
     (itsl1)
     (itsl2)
  )
)

(defun main()
  (iput)
  (compare)
  (setq lastr(computer top bot l))
  (setq res(+ res lastr))
  (prompt "\nThe electrical resistance of the segment is:(Kohm)")
  (prin1 lastr)
  (prompt "\nThe totol electrical resistances is:(Kohm) ")
  (prin1  res)
  (setq x(getstring "\nContinue?(No/<Yes>)"))
     (
     if (and (/= x "No") (/= x "N") (/= X "n") (/= X "no") (/= X "nO") (/= X "NO"))
       (main)
       (setq l1 nil l2 nil l nil top nil bot nil pa1 nil pa2 nil pb1 nil pb2 nil)
     )
)

(defun computer(top bot l)
  (if (> 0.05 (abs(- top bot)))
     (* g_res (/ l top))
     (* l (* g_res (/ (-(log top) (log bot)) (- top bot))))
  )
)

(defun c:rs(/ g_res)
     (setq old_lay (getvar "clayer"))
         (if (tblsearch "layer" "S")
         (command "-layer" "set" "s" "")
         (command "-layer" "m" "s" "c"  "6" "" "")
         )
     (setq ss(ssadd))
     (setq scmde(getvar "cmdecho"))
     (setvar "cmdecho" 0)
     (setq res 0)
     (setq g_res (getreal"\n设置玻璃表面电阻<100om>"))
     (if (not g_res)
         (setq g_res 0.1)
         (setq g_res (/ g_res 1000))
     )
     (main)
         (setq i (sslength ss) j 0)
              (while (< j i)
         (entdel (ssname ss j))
         (setq j (1+ j))
              )
         (setq ss nil)  
     (setvar "cmdecho" scmde)
     (command "layer" "set" old_lay "")
     (PRINC)
)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-11-18 23:29 , Processed in 0.159537 second(s), 32 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表