明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 3473|回复: 14

[提问] 请问想在界址点号前加个“J”应该怎么改?

[复制链接]
发表于 2014-8-20 16:06 | 显示全部楼层 |阅读模式
这个程序是我几年前在这里请一个朋友帮忙写的,现在由于时间太长,无法联系了,本人又不懂LISP程序,现在想要在界址点号前加一个大写字母“J”,不知道怎么改,请大家帮帮忙,急用,谢谢了!

本帖子中包含更多资源

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

x
发表于 2014-8-20 16:48 | 显示全部楼层
猜是这么个加...
不同个领域,您得自己试

(defun MakeText(pt Height Ang str / dxf)
  (setq str (strCat "J" str))
  ...
)

(defun MakeText2(pt Height Ang str / dxf)
   (setq str (strCat "J" str))
  ...
)
 楼主| 发表于 2014-8-20 17:37 | 显示全部楼层
Andyhon 发表于 2014-8-20 16:48
猜是这么个加...
不同个领域,您得自己试

谢谢,不过这样加以后,线段长度前也同样加上了“J”字母了,我想只在界址点号前加,帮忙再改一下呗,谢谢了
发表于 2014-8-20 19:40 | 显示全部楼层
若可提充要的调试文件或可一试
发表于 2014-8-20 22:04 | 显示全部楼层
建议把测试图贴上...
 楼主| 发表于 2014-8-21 08:34 | 显示全部楼层
C:\Users\hellobaby\Desktop\Drawing1-Model.jpg

本帖子中包含更多资源

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

x
发表于 2014-8-21 10:37 | 显示全部楼层
您上的这个图并不能作为调试之用 (得是*.Dwg)
发表于 2014-8-21 10:41 | 显示全部楼层
  1. ;;(prompt "\n\r ***欢迎使用宗地图生成程序***,命令:ZDT")
  2. (defun err(msg)
  3.   (princ msg);"*cancel*")
  4.   (restore)
  5. )
  6. (defun init()
  7.   (command "_.undo" "be")
  8.   (setq dimzin (getvar "dimzin"))
  9.   (setvar "dimzin" 1)
  10.   (setq os (getvar "osmode"))
  11.   (setvar "osmode" 0)
  12.   (setvar "cmdecho" 0)
  13.   (setq errtmp *error*)
  14.   (setq *error* err)
  15. )
  16. (defun restore()
  17.   (setq *error* errtmp)
  18.   (setvar "dimzin" dimzin)
  19.   (setvar "osmode" os)
  20.   (command "_.undo" "e")
  21. )
  22. ;(xl-sort lst fun) = 以取代vl-sort函数,用法相同(lsp)---------------by 无痕
  23. (defun xl-sort (lst fun / nlst)
  24.   (foreach n lst (setq nlst (xl-isort n nlst fun))))
  25. (defun xl-isort (item lst fun / k nlst)
  26.   (setq k T
  27.         nlst (apply 'append (mapcar '(lambda (x)
  28.                                        (if (and K ((eval fun) item x)) (progn (setq k nil) (list item x)) (list x))
  29.                                        ) lst))
  30.   )
  31.   (if k (append lst (list item)) nlst)
  32. )
  33. (defun setcolor(sname color / sinf)
  34.   (setq sinf (entget sname))
  35.   (if (assoc 62 sinf)
  36.     (setq sinf (subst (cons 62 color) (assoc 62 sinf) sinf))
  37.     (setq sinf (append sinf (list (cons 62 color))))
  38.   )
  39.   (entmod sinf)
  40. )

  41. (defun MakeText(pt Height Ang str / dxf)
  42.   (setq dxf '((0 . "TEXT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (100 . "AcDbText")))
  43.   (setq dxf (append dxf (list (cons 10 pt) (cons 40 height) (cons 50 Ang) (cons 1 str))))
  44.   (setq dxf (append dxf '((41 . 0.8) (51 . 0.0) (71 . 0) (72 . 0)
  45.                           (210 0.0 0.0 1.0) (100 . "AcDbText") (73 . 0))))
  46.   (entmake dxf)
  47. )
  48. (defun MakeText2(pt Height Ang str / dxf)
  49.   (setq dxf '((0 . "TEXT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (100 . "AcDbText")(10 0.0 0.0 0.0)))
  50.   (setq dxf (append dxf (list (cons 11 pt) (cons 40 height) (cons 50 Ang) (cons 1 str))))
  51.   (setq dxf (append dxf '((41 . 0.8) (51 . 0.0) (71 . 0) (72 . 1)
  52.                           (210 0.0 0.0 1.0) (100 . "AcDbText") (73 . 2))))
  53.   (entmake dxf)
  54. )
  55. (defun MakeText3(pt Height Ang str / dxf)
  56.   (setq dxf '((0 . "TEXT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (100 . "AcDbText")(10 0.0 0.0 0.0)))
  57.   (setq dxf (append dxf (list (cons 11 pt) (cons 40 height) (cons 50 Ang) (cons 1 (strcat "J" str)))))
  58.   (setq dxf (append dxf '((41 . 0.8) (51 . 0.0) (71 . 0) (72 . 1)
  59.                           (210 0.0 0.0 1.0) (100 . "AcDbText") (73 . 2))))
  60.   (entmake dxf)
  61. )

  62. (defun OpPts(pts pt h scal / pti ptn ptc ang len params pts2 i)
  63.   (setq pts_tmp nil)
  64.   (if (equal (distance (car pts) (last pts)) 0 0.00000000001) (setq pts (cdr pts)))
  65.   (setq pts2 (xl-sort pts '(lambda(e1 e2) (< (abs (- (angle pt e1) (/ pi 4))) (abs (- (angle pt e2) (/ pi 4)))))))
  66.   (while (not (equal (car pts) (car pts2)))
  67.     (setq pts (append (cdr pts) (list (car pts))))
  68.   )
  69.   (setq pti (car pts))
  70.   (foreach ptn (append (cdr pts) (list (car pts)))
  71.     (setq ptc (list (/ (+ (car ptn) (car pti)) 2.0) (/ (+ (cadr ptn) (cadr pti)) 2.0)))
  72.     (setq ang (angle pti ptn))
  73.     (setq len (distance ptn pti))
  74.     (setq params (append params (list (list ang  ptc len))))
  75.     (setq pti ptn)
  76.   )
  77.   (setq i 1)
  78.   (mapcar '(lambda(e) (command "_.circle" e (* scal 0.15)) (setcolor (entlast) 1);可以在这里修改圆圈大小(* scale 0.75)
  79.              (MakeText3 (polar e (angle pt e) h) h 0.0 (itoa i))
  80.              (setq i (1+ i))
  81.            ) pts)
  82.   (mapcar '(lambda(e)
  83.              (MakeText2 (polar (cadr e) (+ (/ pi 2) (car e)) (* 0.75 h))
  84.                h
  85.                (if (and (> (car e) (/ pi 2.0)) (< (car e) (* pi 1.5)))
  86.                         (- (car e) pi)
  87.                  (car e)
  88.                )
  89.                (rtos (last e) 2 2)))
  90.           params)
  91. )

  92. (defun GetVer(ent / pts ents)
  93.   (while (/= (cdr (assoc 0 (setq ents (entget (setq ent (entnext ent)))))) "SEQEND")
  94.     (setq pts (append pts (list (cdr (assoc 10 ents)))))
  95.   )
  96.   pts
  97. )

  98. (defun GETPL (ED / ENTS PTS)
  99.   (setq ENTS (entget ED))
  100.   (while (setq ENTS (member (assoc 10 ENTS) ENTS))
  101.     (setq PTS (append PTS (list (cdar ENTS))))
  102.     (setq ENTS (CDR ENTS))
  103.   )
  104.   PTS
  105. )
  106. (defun Order(pts / n pt ang angn angi angAll pt pti)
  107.   (setq n (length pts))
  108.   (setq pt (list (/ (apply '+ (mapcar 'car pts)) n)
  109.                  (/ (apply '+ (mapcar 'cadr pts)) n)))
  110.   (setq ang (angle pt (car pts)))
  111.   (setq angAll 0)
  112.   (foreach pti (append (cdr pts) (list(car pts)))
  113.     (setq angn (angle pt pti))
  114.     (setq angi (- angn ang))
  115.     (cond
  116.       ((> angi pi) (setq angi (- angi (* pi 2))))
  117.       ((< angi (- pi)) (setq angi (+ angi (* pi 2))))
  118.     )
  119.     (setq angAll (+ angAll angi))
  120.     (setq ang angn)
  121.   )
  122.   (cond
  123.     ((equal angAll 0 1) (list pt nil))
  124.     ((> angAll 0) (list pt nil))
  125.     ((< angAll 0) (list pt t))   
  126.   )
  127. )

  128. (defun DoubleM(ent / ents pt pts l h x y h2)
  129.   (setq ents (entget ent))
  130.   (if (= (cdr (assoc 0 ents)) "TEXT")
  131.     (progn
  132.       (setq pt (cdr (assoc 10 ents)))
  133.       (setq pts (textbox ents))
  134.       (setq l (caadr pts))
  135.       (setq h (cdr (assoc 40 ents)))
  136.       (setq x (+ l (* h 0.4)))
  137.       (setq y (* h 0.7))
  138.       (setq h2 (* h 0.5))
  139.       (MakeText (list (+ (car pt) x) (+ (cadr pt) y)) h2 0 "2")
  140.     )
  141.   )
  142. )
  143. (defun getEnter(ent h nscale scal Bname x y / ss i fenD FENS2 d2
  144.                 zl name th dh lb jz zd zdd fens
  145.                 Wname Nname Cname Rname
  146.                 Wyear Nyear Cyear Ryear
  147.                 Wmon  Nmon  Cmon  Rmon
  148.                 Wday  Nday  Cday  Rday
  149.                 date ent_f ents val)
  150.   (defun getname(ty lst / i str name)
  151.     (setq i 0 str "")
  152.     (setq str (apply 'strcat (mapcar '(lambda(e) (setq i (1+ i)) (strcat (itoa i) "、" e " ") ) lst)))
  153.     (setq str (substr str 1 (1- (strlen str))))
  154.     (setq name (getstring (strcat ty "[" str "]:")))
  155.     (if (and (>= (atoi name) 1) (<= (atoi name) (length lst)))
  156.       (setq name (nth (1- (atoi name)) lst))
  157.     )
  158.     name
  159.   )
  160.   (setq zl (getstring "\n请输入坐落:"))
  161.   (setq name (getstring "\n请输入使用者姓名:"))
  162.   (setq th (getstring "\n请输入图号:"))
  163.   (setq dh (getstring "\n请输入地号:"))
  164.   (setq lb (getstring "\n请输入用地类别:工矿-221,仓储-223,机关团体-241,教育-242,城镇单一住宅-251,城镇混合住宅-252,"))  
  165.   (setq jz (getstring "\n请输入建筑面积(不能为0):"))
  166.   (setq zd (strcat "建筑占地面积:" (getstring "\n请输入建筑占地面积(不能为0):") "m"))  
  167.   (setq Wname (getname "\n请输入外业人姓名:" '("叶文" "杜仁" "金阳" "谢胜")))
  168.   (setq Nname (getname "\n请输入内业人姓名:" '("叶文" "朱威" "金阳" "谢胜")))
  169.   (setq Cname (getname "\n请输入校核人姓名:" '("叶文" "金军" "金阳" "谢胜")))
  170.   (setq Rname (getname "\n请输入复核人姓名:" '("叶文" "金军" "金阳" "毛勤")))
  171.   (setq fenD (getstring "\n需要分摊系数吗?(N)o/<yes>"))
  172.   (if (or (= fenD "") (= (strcase fenD) "Y")) (setq fenD "y") (setq fenD "n"))
  173.   (setq date (rtos (getvar "cdate")))
  174.   (setq wyear (substr date 1 4))
  175.   (setq wmon (substr date 5 2))
  176.   (setq wday (substr date 7 2))
  177.   (setq nyear wyear cyear wyear ryear wyear)
  178.   (setq nmon wmon cmon wmon rmon wmon)
  179.   (setq nday wday cday wday rday wday)
  180.   (command "_.insert" Bname (list (- (car pt) x) (- (cadr pt) y)) nscale "" "")
  181.   (command "_.explode" (entlast))
  182.   (setq ss (ssget "p" '((0 . "TEXT"))))
  183.   (command "_.area" "o" ent)
  184.   (setq ZDD (rtos (getvar "area") 2 2))
  185.   (MakeText pt h 0 zdd)
  186.   (MakeText2 (list (- (car pt) (* 1 h)) (+ (cadr pt) (* 1 h))) h 0 dh)
  187.   (MakeText2 (list (- (car pt) (* 1 h)) (- (cadr pt) (* 0.25 h))) h 0 lb)
  188.   (command "_.line" (list (- (car pt) (* 1.7 h)) (+ (cadr pt) (* 0.375 h))) (list (- (car pt) (* 0.125 h)) (+ (cadr pt) (* 0.375 h))) "")
  189.   (setq fens (/ (atof zdd) (atof jz)))
  190.   (setq fens2 (strcat dh "  -  " "宗分推用地面积=       X" (rtos  fens 2 8) "=       m"))
  191.   (setq fens (strcat "各户分摊系数:" (rtos fens 2 8)))
  192.   (setq jz (strcat "建筑总面积:" jz "m"))
  193.   (setq zdd (strcat "宗地总面积:" zdd "m"))
  194.   (setq i 0)
  195.   (while (< i (sslength ss))
  196.     (setq ent_f (ssname ss i))
  197.     (setq ents (entget ent_f))
  198.     (setq val (cdr (assoc 1 ents)))
  199.     (if (not (and (or (= val "FENS2") (= val "FENS")) (= fenD "n")))
  200.       (if (setq val (eval (read val)))
  201.         (progn
  202.           (if (member (cdr (assoc 1 ents)) '("ZDD" "JZ" "ZD" "FENS2")) (setq d2 t) (setq d2 nil))
  203.           (setq ents (subst (cons 1 val) (assoc 1 ents) ents))          
  204.           (entmod ents)
  205.           (if d2 (doublem ent_f))
  206.         )
  207.       )
  208.       (entdel ent_f)
  209.     )   
  210.     (setq i (1+ i))
  211.   )
  212.   (entupd ent_f)
  213.   (list zl Uname th dh lb jz zd Wname Nname Cname Rname)
  214. )

  215. (defun c:zdt( / pts pt pti ptn ptc ang params)
  216.   (init)
  217.   (setq Scale (getstring "\n请输入比例尺<1:200>:"))
  218.   (if (= Scale "")
  219.     (progn
  220.       (setq blc "1:200")
  221.       (setq nScale 1)(setq h 0.45);可以在这里修改标注文字大小
  222.     )
  223.     (progn
  224.       (setq nScale (/ (atof scale) 200))
  225.       (setq blc (strcat "1:" scale))
  226.       (setq h (* 0.45 (/ (atof scale) 200) ));可以在这里修改标注文字大小
  227.     )
  228.   )
  229.   (setq ent (car (entsel "\n请选择图形...")))
  230.   (setq pts (getpl ent))
  231.   (if (cadr (setq pt (Order (reverse pts))))
  232.     (setq pts (reverse pts))
  233.   )
  234.   (setq pt (car pt))
  235.   (setq xc (* 0.10 nscale));可以在这里修改线粗
  236.   (command "_.pedit" ent "w" xc "")
  237.   (setcolor ent 1)
  238.   (OpPts pts pt h nscale)  
  239.   (getEnter ent h nscale scale "8kh" (* nscale 30) (* nscale 18.4))
  240.   (princ "\n\nEnd!")
  241.   (restore)
  242.   (princ)
  243. )

点评

不错,可以使用。  发表于 2014-8-21 15:44
 楼主| 发表于 2014-8-21 11:16 | 显示全部楼层
reyun 发表于 2014-8-21 10:41

就随便画一个闭合的多边形,然后加载程序调试一下就可以了,图框跟这个应该没有关系的,我原先程序点一下图形,就会生成第一幅图,不过各个点号前没有"J"字母,现在想改一下程序,在点号前加上字母"J“,谢谢
发表于 2014-8-21 11:24 | 显示全部楼层
yes1415 发表于 2014-8-21 11:16
就随便画一个闭合的多边形,然后加载程序调试一下就可以了,图框跟这个应该没有关系的,我原先程序点一下 ...

改了的,你看看可以用了不?
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 14:13 , Processed in 0.251362 second(s), 31 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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