找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 623|回复: 0

[求助] [求助]:请帮我看看这个程序问题出在哪里?谢谢

[复制链接]
发表于 2005-6-17 17:13:38 | 显示全部楼层 |阅读模式

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

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

×

  1. ;(defun c:test()
  2. ;(setq file-new (getfiled "选择数据文件" "d:/" "dat" 8))
  3. ;(setq zg (getreal "   输入字高< 0.4 >:"))
  4. ;(if (not zg) (setq ZG 0.4))
  5. ;(command "layer" "m" "kzd" "color" "red" "" "")
  6. ;(setq file (open file-new "r"))
  7. (setq zg 0.4)
  8. (setq BMG "abc" pts nil)
  9. (setq file(open "d://data2.txt" "r"))
  10. (while (setq text0(read-line file))  
  11.         (setq len (strlen text0)
  12.      n1(vl-string-search "," text0)
  13.      n2(vl-string-search "," text0 (+ n1 1))
  14.      n3(vl-string-search "," text0 (+ n2 1))
  15.      n4(vl-string-search "," text0 (+ n3 1))
  16.      dh(substr text0 1 n1)
  17.             bm(substr text0 (+ n1 2) (- n2 n1 1))
  18.       y(atof(substr text0(+ n2 2) (- n3 n2 1)))
  19.       x(atof(substr text0(+ n3 2) (- n4 n3 1)))
  20.              h(substr text0(+ n4 2) (- len n4 1))
  21.       pt-crd(list y x)
  22.              pt-dh(list (+ y 0.2)  x)
  23.       pt-gc(list (+ y 0.5) x)  
  24.           );setq束
  25.    
  26.    (if (= bmg bm)
  27.     (progn
  28.        (setq str (vl-string-translate "," " " text0))
  29.        (setq str (read (strcat "(" str ")")))
  30.        (setq pts (append pts (list (cddr str))))
  31.     );progn
  32.     (progn
  33.        (setq pts2 (mapcar '(lambda (e1 e2) (list (distance e1 e2) e1 e2)) (reverse (cdr (reverse pts))) (cdr pts)))
  34.        (setq pts2 (vl-sort pts2 '(lambda (e1 e2) (> (car e1) (car e2)))))
  35.        (command "pline")
  36.        (mapcar 'command pts)
  37.        (command "")
  38.        (setq ptm1 (cadar pts2) ptm2 (caddar pts2))
  39.        (setq ptc (mapcar '(lambda (e1 e2) (/ (+ e1 e2) 2)) ptm1 ptm2))
  40.        (setq ang (angle ptm1 ptm2))
  41.        (command "text" "j" "c" ptc zg (angtos ang) bmg)
  42.        (setq pts nil str nil)
  43.        (setq str (vl-string-translate "," " " text0))
  44.        (setq str (read (strcat "(" str ")")))
  45.        (setq pts (append pts (list (cddr str))))
  46.    );progn
  47. );if
  48.    (setq bmg bm)
  49. );while
  50. ;-----------------------------------------------------------------
  51. (setq pts2 (mapcar '(lambda (e1 e2) (list (distance e1 e2) e1 e2)) (reverse (cdr (reverse pts))) (cdr pts)))
  52.        (setq pts2 (vl-sort pts2 '(lambda (e1 e2) (> (car e1) (car e2)))))
  53.        (command "pline")
  54.        (mapcar 'command pts)
  55.        (command "")
  56.        (setq ptm1 (cadar pts2) ptm2 (caddar pts2))
  57.        (setq ptc (mapcar '(lambda (e1 e2) (/ (+ e1 e2) 2)) ptm1 ptm2))
  58.        (setq ang (angle ptm1 ptm2))
  59.        (command "text" "j" "c" ptc zg (angtos ang) bmg)
  60. ;-----------------------------------------------------------------
  61. (command "")
  62. (close file)
  63. (command "zoom" "e")
  64. (princ)

这个程序是根据数据文件的数数据,连线并注记线段名称,格式如下:

1,abc,-49.265,382.975,-10.577
2,abc,-49.327,386.58,-10.407
3,abc,-56.292,386.823,-9.923
4,eee,-56.109,383.79,-10.672
5,eee,-56.06,383.707,-10.679
6,eee,-59.786,386.658,-9.742
程序根据第二项即,所有abc的连成一条线,并在最长的那线段间注记上abc;eee的连成另外一条线,且也是要注记eee.谢谢各位
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

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

GMT+8, 2025-9-28 07:00 , Processed in 0.177638 second(s), 32 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

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