请问想在界址点号前加个“J”应该怎么改？
这个程序是我几年前在这里请一个朋友帮忙写的，现在由于时间太长，无法联系了，本人又不懂LISP程序，现在想要在界址点号前加一个大写字母“J”，不知道怎么改，请大家帮帮忙，急用，谢谢了！猜是这么个加...
不同个领域,您得自己试
(defun MakeText(pt Height Ang str / dxf)
(setq str (strCat "J" str))
...
)
(defun MakeText2(pt Height Ang str / dxf)
(setq str (strCat "J" str))
...
) Andyhon 发表于 2014-8-20 16:48 static/image/common/back.gif
猜是这么个加...
不同个领域,您得自己试
谢谢，不过这样加以后，线段长度前也同样加上了“J”字母了，我想只在界址点号前加，帮忙再改一下呗，谢谢了 若可提充要的调试文件或可一试 建议把测试图贴上... C:\Users\hellobaby\Desktop\Drawing1-Model.jpg 您上的这个图并不能作为调试之用 (得是*.Dwg) ;;(prompt "\n\r ***欢迎使用宗地图生成程序***,命令:ZDT")
(defun err(msg)
(princ msg);"*cancel*")
(restore)
)
(defun init()
(command "_.undo" "be")
(setq dimzin (getvar "dimzin"))
(setvar "dimzin" 1)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setq errtmp *error*)
(setq *error* err)
)
(defun restore()
(setq *error* errtmp)
(setvar "dimzin" dimzin)
(setvar "osmode" os)
(command "_.undo" "e")
)
;(xl-sort lst fun) = 以取代vl-sort函数，用法相同(lsp)---------------by 无痕
(defun xl-sort (lst fun / nlst)
(foreach n lst (setq nlst (xl-isort n nlst fun))))
(defun xl-isort (item lst fun / k nlst)
(setq k T
nlst (apply 'append (mapcar '(lambda (x)
(if (and K ((eval fun) item x)) (progn (setq k nil) (list item x)) (list x))
) lst))
)
(if k (append lst (list item)) nlst)
)
(defun setcolor(sname color / sinf)
(setq sinf (entget sname))
(if (assoc 62 sinf)
(setq sinf (subst (cons 62 color) (assoc 62 sinf) sinf))
(setq sinf (append sinf (list (cons 62 color))))
)
(entmod sinf)
)
(defun MakeText(pt Height Ang str / dxf)
(setq dxf '((0 . "TEXT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (100 . "AcDbText")))
(setq dxf (append dxf (list (cons 10 pt) (cons 40 height) (cons 50 Ang) (cons 1 str))))
(setq dxf (append dxf '((41 . 0.8) (51 . 0.0) (71 . 0) (72 . 0)
(210 0.0 0.0 1.0) (100 . "AcDbText") (73 . 0))))
(entmake dxf)
)
(defun MakeText2(pt Height Ang str / dxf)
(setq dxf '((0 . "TEXT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (100 . "AcDbText")(10 0.0 0.0 0.0)))
(setq dxf (append dxf (list (cons 11 pt) (cons 40 height) (cons 50 Ang) (cons 1 str))))
(setq dxf (append dxf '((41 . 0.8) (51 . 0.0) (71 . 0) (72 . 1)
(210 0.0 0.0 1.0) (100 . "AcDbText") (73 . 2))))
(entmake dxf)
)
(defun MakeText3(pt Height Ang str / dxf)
(setq dxf '((0 . "TEXT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (100 . "AcDbText")(10 0.0 0.0 0.0)))
(setq dxf (append dxf (list (cons 11 pt) (cons 40 height) (cons 50 Ang) (cons 1 (strcat "J" str)))))
(setq dxf (append dxf '((41 . 0.8) (51 . 0.0) (71 . 0) (72 . 1)
(210 0.0 0.0 1.0) (100 . "AcDbText") (73 . 2))))
(entmake dxf)
)
(defun OpPts(pts pt h scal / pti ptn ptc ang len params pts2 i)
(setq pts_tmp nil)
(if (equal (distance (car pts) (last pts)) 0 0.00000000001) (setq pts (cdr pts)))
(setq pts2 (xl-sort pts '(lambda(e1 e2) (< (abs (- (angle pt e1) (/ pi 4))) (abs (- (angle pt e2) (/ pi 4)))))))
(while (not (equal (car pts) (car pts2)))
(setq pts (append (cdr pts) (list (car pts))))
)
(setq pti (car pts))
(foreach ptn (append (cdr pts) (list (car pts)))
(setq ptc (list (/ (+ (car ptn) (car pti)) 2.0) (/ (+ (cadr ptn) (cadr pti)) 2.0)))
(setq ang (angle pti ptn))
(setq len (distance ptn pti))
(setq params (append params (list (list angptc len))))
(setq pti ptn)
)
(setq i 1)
(mapcar '(lambda(e) (command "_.circle" e (* scal 0.15)) (setcolor (entlast) 1);可以在这里修改圆圈大小(* scale 0.75)
(MakeText3 (polar e (angle pt e) h) h 0.0 (itoa i))
(setq i (1+ i))
) pts)
(mapcar '(lambda(e)
(MakeText2 (polar (cadr e) (+ (/ pi 2) (car e)) (* 0.75 h))
h
(if (and (> (car e) (/ pi 2.0)) (< (car e) (* pi 1.5)))
(- (car e) pi)
(car e)
)
(rtos (last e) 2 2)))
params)
)
(defun GetVer(ent / pts ents)
(while (/= (cdr (assoc 0 (setq ents (entget (setq ent (entnext ent)))))) "SEQEND")
(setq pts (append pts (list (cdr (assoc 10 ents)))))
)
pts
)
(defun GETPL (ED / ENTS PTS)
(setq ENTS (entget ED))
(while (setq ENTS (member (assoc 10 ENTS) ENTS))
(setq PTS (append PTS (list (cdar ENTS))))
(setq ENTS (CDR ENTS))
)
PTS
)
(defun Order(pts / n pt ang angn angi angAll pt pti)
(setq n (length pts))
(setq pt (list (/ (apply '+ (mapcar 'car pts)) n)
(/ (apply '+ (mapcar 'cadr pts)) n)))
(setq ang (angle pt (car pts)))
(setq angAll 0)
(foreach pti (append (cdr pts) (list(car pts)))
(setq angn (angle pt pti))
(setq angi (- angn ang))
(cond
((> angi pi) (setq angi (- angi (* pi 2))))
((< angi (- pi)) (setq angi (+ angi (* pi 2))))
)
(setq angAll (+ angAll angi))
(setq ang angn)
)
(cond
((equal angAll 0 1) (list pt nil))
((> angAll 0) (list pt nil))
((< angAll 0) (list pt t))
)
)
(defun DoubleM(ent / ents pt pts l h x y h2)
(setq ents (entget ent))
(if (= (cdr (assoc 0 ents)) "TEXT")
(progn
(setq pt (cdr (assoc 10 ents)))
(setq pts (textbox ents))
(setq l (caadr pts))
(setq h (cdr (assoc 40 ents)))
(setq x (+ l (* h 0.4)))
(setq y (* h 0.7))
(setq h2 (* h 0.5))
(MakeText (list (+ (car pt) x) (+ (cadr pt) y)) h2 0 "2")
)
)
)
(defun getEnter(ent h nscale scal Bname x y / ss i fenD FENS2 d2
zl name th dh lb jz zd zdd fens
Wname Nname Cname Rname
Wyear Nyear Cyear Ryear
WmonNmonCmonRmon
WdayNdayCdayRday
date ent_f ents val)
(defun getname(ty lst / i str name)
(setq i 0 str "")
(setq str (apply 'strcat (mapcar '(lambda(e) (setq i (1+ i)) (strcat (itoa i) "、" e " ") ) lst)))
(setq str (substr str 1 (1- (strlen str))))
(setq name (getstring (strcat ty "[" str "]:")))
(if (and (>= (atoi name) 1) (<= (atoi name) (length lst)))
(setq name (nth (1- (atoi name)) lst))
)
name
)
(setq zl (getstring "\n请输入坐落:"))
(setq name (getstring "\n请输入使用者姓名:"))
(setq th (getstring "\n请输入图号:"))
(setq dh (getstring "\n请输入地号:"))
(setq lb (getstring "\n请输入用地类别:工矿-221,仓储-223,机关团体-241,教育-242,城镇单一住宅-251,城镇混合住宅-252,"))
(setq jz (getstring "\n请输入建筑面积(不能为0):"))
(setq zd (strcat "建筑占地面积:" (getstring "\n请输入建筑占地面积(不能为0):") "m"))
(setq Wname (getname "\n请输入外业人姓名:" '("叶文" "杜仁" "金阳" "谢胜")))
(setq Nname (getname "\n请输入内业人姓名:" '("叶文" "朱威" "金阳" "谢胜")))
(setq Cname (getname "\n请输入校核人姓名:" '("叶文" "金军" "金阳" "谢胜")))
(setq Rname (getname "\n请输入复核人姓名:" '("叶文" "金军" "金阳" "毛勤")))
(setq fenD (getstring "\n需要分摊系数吗?(N)o/<yes>"))
(if (or (= fenD "") (= (strcase fenD) "Y")) (setq fenD "y") (setq fenD "n"))
(setq date (rtos (getvar "cdate")))
(setq wyear (substr date 1 4))
(setq wmon (substr date 5 2))
(setq wday (substr date 7 2))
(setq nyear wyear cyear wyear ryear wyear)
(setq nmon wmon cmon wmon rmon wmon)
(setq nday wday cday wday rday wday)
(command "_.insert" Bname (list (- (car pt) x) (- (cadr pt) y)) nscale "" "")
(command "_.explode" (entlast))
(setq ss (ssget "p" '((0 . "TEXT"))))
(command "_.area" "o" ent)
(setq ZDD (rtos (getvar "area") 2 2))
(MakeText pt h 0 zdd)
(MakeText2 (list (- (car pt) (* 1 h)) (+ (cadr pt) (* 1 h))) h 0 dh)
(MakeText2 (list (- (car pt) (* 1 h)) (- (cadr pt) (* 0.25 h))) h 0 lb)
(command "_.line" (list (- (car pt) (* 1.7 h)) (+ (cadr pt) (* 0.375 h))) (list (- (car pt) (* 0.125 h)) (+ (cadr pt) (* 0.375 h))) "")
(setq fens (/ (atof zdd) (atof jz)))
(setq fens2 (strcat dh "-" "宗分推用地面积= X" (rtosfens 2 8) "= m"))
(setq fens (strcat "各户分摊系数:" (rtos fens 2 8)))
(setq jz (strcat "建筑总面积:" jz "m"))
(setq zdd (strcat "宗地总面积:" zdd "m"))
(setq i 0)
(while (< i (sslength ss))
(setq ent_f (ssname ss i))
(setq ents (entget ent_f))
(setq val (cdr (assoc 1 ents)))
(if (not (and (or (= val "FENS2") (= val "FENS")) (= fenD "n")))
(if (setq val (eval (read val)))
(progn
(if (member (cdr (assoc 1 ents)) '("ZDD" "JZ" "ZD" "FENS2")) (setq d2 t) (setq d2 nil))
(setq ents (subst (cons 1 val) (assoc 1 ents) ents))
(entmod ents)
(if d2 (doublem ent_f))
)
)
(entdel ent_f)
)
(setq i (1+ i))
)
(entupd ent_f)
(list zl Uname th dh lb jz zd Wname Nname Cname Rname)
)
(defun c:zdt( / pts pt pti ptn ptc ang params)
(init)
(setq Scale (getstring "\n请输入比例尺<1:200>:"))
(if (= Scale "")
(progn
(setq blc "1:200")
(setq nScale 1)(setq h 0.45);可以在这里修改标注文字大小
)
(progn
(setq nScale (/ (atof scale) 200))
(setq blc (strcat "1:" scale))
(setq h (* 0.45 (/ (atof scale) 200) ));可以在这里修改标注文字大小
)
)
(setq ent (car (entsel "\n请选择图形...")))
(setq pts (getpl ent))
(if (cadr (setq pt (Order (reverse pts))))
(setq pts (reverse pts))
)
(setq pt (car pt))
(setq xc (* 0.10 nscale));可以在这里修改线粗
(command "_.pedit" ent "w" xc "")
(setcolor ent 1)
(OpPts pts pt h nscale)
(getEnter ent h nscale scale "8kh" (* nscale 30) (* nscale 18.4))
(princ "\n\nEnd!")
(restore)
(princ)
) reyun 发表于 2014-8-21 10:41 static/image/common/back.gif
就随便画一个闭合的多边形，然后加载程序调试一下就可以了，图框跟这个应该没有关系的，我原先程序点一下图形，就会生成第一幅图，不过各个点号前没有"J"字母，现在想改一下程序，在点号前加上字母"J“，谢谢 yes1415 发表于 2014-8-21 11:16 static/image/common/back.gif
就随便画一个闭合的多边形，然后加载程序调试一下就可以了，图框跟这个应该没有关系的，我原先程序点一下 ...
改了的，你看看可以用了不？
页:
[1]
2