文字批量替换，数字递增 （有些小问题，但是程序可以正常用）
本帖最后由 zhb236623 于 2013-8-19 16:54 编辑问题有三个：SSGET选择,
一 、SSGET :;(setq dff "302002")
;(setq ss (ssget(list (list -3 ( list "south" (cons 1000 dff))))))这句要怎么写？因为图纸中有很多文字，直接用这句不好框选(setq ss (ssget'((0 . "*TEXT"))))
。
(setq ss (ssget "x" (list (list -3 ( list "south" (cons 1000 dff))))))如果不要整个图形选，要框选要怎么改呢。？
二 、getstring
(if (not(setq dh_n (getstring "\n请输入地号（前缀）四位数 <0001>: ")))
(setq dh_n "0001")
)
这里直接按回车dh_n值 为空，要怎样才能按空格使(setq dh_n "0001")这句生效。
三 、entmake 用法不太会，盼高手解答下
有这三个)(cons 71 1)(cons 72 1)(cons 73 1)就要加(cons 11 insertp_mid)(cons 10 insertp_mid) 那生成的时候用的哪个坐标
;;(entmake (list '(0 . "TEXT") (cons 1 wz) (cons 7"仿宋体") (cons 11 insertp_mid)(cons 10 insertp_mid) (cons 40 0.5)(cons 41 0.8)(cons 71 1)(cons 72 1)(cons 73 1)(cons 8 "jj")))
只好用这个方法生成文字
(command ".style" "仿宋体" "仿宋_GB2312" wz_dx 0.8 0 "" "")
(command ".text" "j" "bc" insertp_mid 0 wz)
测试图纸发上来了。
之前发过的一个帖子。http://bbs.mjtd.com/thread-106952-1-1.html
(defun c:tt()
(if (= (tblobjname "layer" "JMD_zd01") nil)
(progn
(command ".layer" "n" "JMD_zd01" "s" "JMD_zd01" "")
)
(progn
(command "layer" "s" "JMD_zd01" "")
)
)
(vl-load-com)
(setq ss (ssget'((0 . "*TEXT"))))
;(regapp "south")
;(setq dff "302002")
;(setq ss (ssget(list (list -3 ( list "south" (cons 1000 dff))))))
;(ssget (list (list -3(list "SOUTH"))))
;(setq ss (ssget (list -3 ( list "south" (cons 1000 dff)))))
(if (not(setq dh_n (getstring "\n请输入地号（前缀）四位数 <0001>: ")))
(setq dh_n "0001")
)
(if (not (setq n1 (getint "\n请输入尾数起始顺序号 <1>: ")))
(setq n1 1)
)
(if (not (setq wz_dx (getdist "\n请输入文字大小 <0.6>: ")))
(setq wz_dx 0.6)
)
;;地号最后三位数不够补0，例3＝003，34＝034，189＝189
;(command ".style" "仿宋体" "仿宋_GB2312" wzstyle 1 0 "" "")
(setq slist nil)
(setq i 0)
(repeat (sslength ss)
(setq en (ssname ss i)) ;(setq en (entget ssn))
;| (vla-getboundingbox (vlax-ename->vla-object en)
'minpoint
'maxpoint
)
(setq pmax (vlax-safearray->list maxpoint)
pmin (vlax-safearray->list minpoint)
)
(setq xmin (car pmin))
(setq xmax (car pmax))
(setq ymin (cadr pmin))
(setq ymax (cadr pmax))
(setq xmid (/ (+ xmin xmax) 2))
;;(setq ymid ( / ( + ymin ymax) 2))
(setq xmid_ymax (list xmid ymin)) |;
(setq ept (entget en))
(setq lxyz (cdr (assoc 11ept)))
(setq xx (car lxyz))
(setq yy (cadr lxyz))
(setq xmid_ymax (list xx yy))
(setq slist (cons xmid_ymax slist))
(setq i (1+ i))
)
;;;关键就是这里了，排序，1e-6为容差，意思是1乘以10的负6次方。你可以自己改
;;(setq tmp_slist (dh_zhy_sort_pt slist 1e-6))
(setq tmp_slist (dh_zhy_sort_pt slist 3))
(foreach insertp_mid tmp_slist
;;(setq insertp_move (pmove insertp_mid 0 wz_insertp_move_down)) ;;;最后一位为向下移动距离
(cond
((< n1 10)
(setq wz_n(strcat "00" (itoa n1)))
)
( (< 9 n1 100)
(setq wz_n(strcat "0" (itoa n1)))
)
( (> n1 99)
(setq wz_n (itoa n1))
)
)
;;;;;;;;;;
;(princ insertp_mid )
;(setq insertp_mid_tt (list 100 300))
;(princ insertp_mid_tt )
;(entmake (list '(0 . "TEXT") (cons 1 "me1") (cons 7"仿宋体") (cons 11 insertp_mid_tt) (cons 10 insertp_mid_tt)(cons 40 0.5)(cons 41 0.8)(cons 71 1)(cons 72 1)(cons 73 1)(cons 8 "jj")))
;;;;;;;;;;;;;
(setq wz (strcat dh_n wz_n)) ;;;
;;;就是要如何才能更改这个坐标点对应的文字呢？
;;直接生成文字可能还更容易……
;;(setq P_center_fz_nn_d1 (list 3 5))
;;(entmake (list '(0 . "TEXT") (cons 1 wz) (cons 7"仿宋体") (cons 11 insertp_mid)(cons 10 insertp_mid) (cons 40 0.5)(cons 41 0.8)(cons 71 1)(cons 72 1)(cons 73 1)(cons 8 "jj")))
(command ".style" "仿宋体" "仿宋_GB2312" wz_dx 0.8 0 "" "")
(command ".text" "j" "bc" insertp_mid 0 wz)
(setq n1 (+ n1 1))
)
(command "erase" ss "")
(setq ss1 (ssget "x" '((0 . "text")(8 . "JMD_zd01"))))
(command "putp" "c" "302002"ss1 "")
(command "layer" "s" "0" "")
)
;;;;取得点集行数，将每行的y坐标列表，lst为点坐标表，rc为容差
(defun y_lst (lst rc / it lst2)
(while (setq lst2 (cons (setq it (cadr (car lst))) lst2)
lst(vl-remove-if '(lambda (x) (equal it (cadr x) rc)) lst)
)
)
(vl-sort lst2 (function (lambda (e1 e2) (> e1 e2))))
)
;;;将点集按从上到下，从左到右的顺序排序。pt_lst为点坐标表，rc为容差
(defun dh_zhy_sort_pt (pt_lst rc / pt_y lst1 pt_lst_new n1 n2 m1 m2 pt_y_a pt_lst_a lst2)
(setq pt_y (y_lst pt_lst rc))
(setq pt_lst_new '())
(setq lst1 '())
(setq m1 0)
(setq n1 (length pt_y))
(setq n2 (length pt_lst))
(while (/= m1 n1)
(setq pt_y_a (nth m1 pt_y))
(setq m2 0)
(while (/= m2 n2)
(setq pt_lst_a (nth m2 pt_lst))
(if (equal pt_y_a (cadr pt_lst_a) rc)
(setq lst1 (cons pt_lst_a lst1))
)
(setq m2 (1+ m2))
)
(if (/= (length lst1) 1)
(setq lst1 (vl-sort lst1
(function (lambda (e1 e2) (< (car e1) (car e2))))
)
)
)
(setq pt_lst_new (cons lst1 pt_lst_new))
(setq lst1 '())
(setq m1 (1+ m1))
)
(setq pt_lst_new (reverse pt_lst_new))
(setq n1 (length pt_lst_new))
(setq m1 0)
(setq lst2 '())
(while (/= m1 n1)
(setq lst1 (nth m1 pt_lst_new))
(setq n2 (length lst1))
(setq m2 0)
(while (/= m2 n2)
(setq lst (nth m2 lst1))
(setq lst2 (cons lst lst2))
(setq m2 (1+ m2))
)
(setq m1 (1+ m1))
)
(reverse lst2)
) 顶一下 顶一下只是数字递增么 上面代码和我用VBA写的编制页码的程序是相似的，一个是VBA，一个是LISP。谢谢楼主分享 这个搞好了吗，能发个源程序给我不，我的邮箱是yxl33168@163.com 谢谢你
页:
[1]