b.lsp

此代码为Lisp语言编写

(defun c:gdmx(/ pt1 pt2)
        (setq pt1(getpoint "\n地面线上第一点:"))
        (if pt1(setq pt2(getpoint pt1 "\n地面线上第二点:")))
        (if (and pt1 pt2)(hdmx pt1 pt2))
)
(defun c:chp( / pw ss s1 nn n1)
		 (setq ss(ssget) nn(sslength ss) n1 0)
                 (setq pw(getreal (strcat "\n输入线宽<" (rtos1 pw_a 2) ">:")))
                 (if (not pw)(setq pw pw_a))
		 (repeat nn
					(setq s1(ssname ss n1))
                    (cond ((or (= (cdr (assoc 0 (entget s1))) "POLYLINE")(= (cdr (assoc 0 (entget s1))) "LWPOLYLINE"))
							 (command "pedit" s1 "w" pw "x"))
			    ((= (cdr (assoc 0 (entget s1))) "ARC")
			     (command "pedit" s1 "Y" "w" pw "x"))
							((= (cdr (assoc 0 (entget s1))) "LINE")
							 (command "pedit" s1 "Y" "w" pw "x")))
					(setq n1(1+ n1))
		 )
)
(defun c:chtw( / ss nn n1 e1 hh)
     (setq hh (getreal "输入字高宽比<0.8>:"))
	 (if (not hh) (setq hh 0.8))
		 (setq ss(ssget "X" (list (cons 0 "TEXT")))
				 nn(sslength ss) n1 0)
		 (repeat nn
					(setq e1(entget (ssname ss n1))
							e1(subst (cons 41 hh) (assoc 41 e1) e1)
							n1(+ 1 n1))
					(entmod e1))
		 (princ))
(defun c:chth( / ss nn n1 e1 hh)
         (print "\n选择要改变字高的文本:")
		 (setq ss(ssget)) 
		 (if ss (setq nn(sslength ss) n1 0) (setq nn 0))
         (if ss (setq hh(getreal "\n输入字高:")))
		 (repeat nn
					(setq e1(entget (ssname ss n1)))
					(if (= (cdr (assoc 0 e1)) "TEXT")(progn
						(setq e1(subst (cons 40 hh) (assoc 40 e1) e1))
						(entmod e1)
					))
					(setq n1(+ 1 n1)))
		 (princ))
(defun c:chzh( / ss nn n1 e1 hh zhk zhl zh)
;将数值转换为桩号
         (print "\n选择文本:")
		 (setq ss(ssget)) 
		 (if ss (setq nn(sslength ss) n1 0) (setq nn 0))
		 (repeat nn
					(setq e1(entget (ssname ss n1)))
                                        (setq zh(distof (cdr (assoc 1 e1))))
                                        (if (and (= (cdr (assoc 0 e1)) "TEXT") zh)(progn
                                                (setq zhk(fix (/ zh 1000))zhl(- zh (* zhk 1000)))
						(setq e1(subst (cons 1 (strcat "K" (rts zhk) "+" (rts zhl))) (assoc 1 e1) e1))
						(entmod e1)
					))
                                        (setq n1(+ 1 n1)))
		 (princ)
)
(defun c:tj( / ss len n1 n2 tt e1 tl xs)
         (print "选择要统计的文本:")(setq tl 0 n2 0)
		 (setq ss(ssget))
		 (if ss(progn
			 (setq len(sslength ss) n1 0)
			 (repeat len
				(setq e1(entget(ssname ss n1)))
				(if (and (= (cdr (assoc 0 e1)) "TEXT") (setq tt(distof (cdr (assoc 1 e1)))))
					(setq tl(+ tt tl) n2(1+ n2)))
					(setq n1(1+ n1))
				)
			 )
		 )
         (setq xs(getreal "\n输入倍数<1.0>:"))
		 (if(not xs) (setq xs 1.0))
         (print "选择一个要改变的文本<不改变任何文本则回车>:")(setq ss(ssget))
		 (if ss(setq e1(entget(ssname ss 0)))(setq e1 nil))
		 (if (and e1 (= (cdr (assoc 0 e1)) "TEXT"))
		     (progn
            (setq n1 nil n1(getint "要保留的小数位数<2>:"))
			(if (not n1) (setq n1 2))
			(setq e1(subst (cons 1 (rtos (* tl xs) 2 n1)) (assoc 1 e1) e1))
			(entmod e1)
		     )
		 )
		 (print (strcat "总和*"(rtos xs 2 5) "=" (rtos (* tl xs) 2 5)))
		 (if (= n2 0)
			(print "总和=0 个数=0 平均=0")
			(print (strcat "总和=" (rtos tl 2 5) " 个数=" (itoa n2)
				" 平均=" (rtos (/ tl n2) 2 5)))
		 )
		 (princ)
)
(defun c:tjt( / ss len n1 n2 tt e1 tl xs ts)
         (print "选择要统计的文本:")(setq tl 0 n2 0)
		 (setq ss(ssget))
		 (if ss(progn
			 (setq len(sslength ss) n1 0)
			 (repeat len
				(setq e1(entget(ssname ss n1)))
				(if (and (= (cdr (assoc 0 e1)) "TEXT") (setq tt(distof (cdr (assoc 1 e1)))))
					(setq tl(+ tt tl) n2(1+ n2)))
					(setq n1(1+ n1))
				)
			 )
		 )
     (setq ts(entsel "\n选择系数文本<1.0>:"))
	 (if (not ts)
	     (setq xs 1.0)
	     (progn
		(setq e1(entget (car ts)))
		(if (or (/= (cdr (assoc 0 e1)) "TEXT") (not (distof (cdr (assoc 1 e1)))))
		    (setq xs 1.0)
		    (setq xs (distof (cdr (assoc 1 e1))))
		)
	     )
	 )
     (setq ss(entsel "\n选择一个要改变的文本<不改变任何文本则回车>:"))
	 (if ss(setq e1(entget(car ss)))(setq e1 nil))
	 (if (and e1 (= (cdr (assoc 0 e1)) "TEXT"))
		     (progn
            (setq n1 nil n1(getint "Enter number of Dig. <2>:"))
			(if (not n1) (setq n1 2))
			(setq e1(subst (cons 1 (rtos (* tl xs) 2 n1)) (assoc 1 e1) e1))
			(entmod e1)
		     )
		 )
		 (print (strcat "总和*" (rtos xs 2 5) "=" (rtos (* tl xs) 2 5)))
		 (if (= n2 0)
			(print "总和=0 个数=0 平均=0")
			(print (strcat "总和=" (rtos tl 2 5) " 个数=" (itoa n2)
				" 平均=" (rtos (/ tl n2) 2 5)))
		 )
		 (princ)
)
(defun c:tim( / ss nn n1 e1 ar t1 i)
    (print "\n选择要改变的文本:")
	(setq ss(ssget) i 0)
	(if ss (setq nn(sslength ss) n1 0) (setq nn 0))
    (if ss (setq ar(getreal "\n输入相乘系数:")))
	(repeat nn	
		(setq e1(entget (ssname ss n1)))
		(if (= (cdr (assoc 0 e1)) "TEXT")(progn
			(setq t1 (read (cdr (assoc 1 e1)))
                  e1(subst (cons 1 (rtos (* t1 ar) 2 bzw)) (assoc 1 e1) e1))
			(entmod e1)(setq i(1+ i))
			)
		)
		(setq n1(+ 1 n1))
	)
	i
)
(defun c:adi( / ss nn n1 e1 ar t1 i)
;增加数值
	(setq ss(ssget) i 0)
	(if ss (setq nn(sslength ss) n1 0) (setq nn 0))
	(if ss (setq ar (read (getstring "\nEnter a real to add:"))))
	(if (not ar)(setq nn 0))
	(repeat nn
		(setq e1(entget (ssname ss n1)))
		(if (= (cdr (assoc 0 e1)) "TEXT")(progn
			(setq t1 (cdr (assoc 1 e1))
			      e1(subst (cons 1 (stradd1 t1 ar)) (assoc 1 e1) e1))
			(entmod e1)(setq i(1+ i))
			)
		)
		(setq n1(+ 1 n1))
	)
        i
)
(defun n_text(ptc h an t j / l1 l2 l3)
	(if (<= j 0)(setq j 1))
	(setq l1(cons 10 ptc) l2(cons 40 h) l3(cons 50 an))
	(entmake (list (cons 0 "TEXT")(cons 1 t)L1 L2 L3 (cons 72 j)))
)
(defun n_lin1(pt1 pt2)
	(entmake (list (cons 0 "LINE")(cons 10 pt1)(cons 11 pt2)))
)
(defun n_begb(n)
	(entmake (list (cons 0 "BLOCK")(cons 2 n)'(10 0 0 0)(cons 70 64)))
)
(defun n_endb()
	(entmake (list (cons 0 "ENDBLK")))
)
(defun n_hbg1(jd sphs / d1 d2 d3 d4 d5 d6 i)
	 (stx1 jd "钢筋数量表")
		 (setq d1(ppt jd -31 -3) d2(polar d1 0 62) 
				 d3(polar d1 pi3 12) d4(polar d2 pi3 12) 
				 d5 (polar d3 pi3 (* bg_a sphs)) d6(polar d4 pi3 (* bg_a sphs)))
		 (n_begb "b1_gcl")
		 (n_lin1 d1 d2)(n_lin1 d1 d5)(n_lin1 d2 d6)
		 (repeat (+ sphs 1) 
				(n_lin1 d3 d4)
				(setq d3 (polar d3 pi3 bg_a) d4(polar d4 pi3 bg_a)))
		 (setq d3(polar d1 0 8) d4(polar d5 0 8))(n_lin1 d3 d4)
		 (setq d3(polar d3 0 12) d4(polar d4 0 12))(n_lin1 d3 d4)
		 (setq d3(polar d3 0 16) d4(polar d4 0 16))(n_lin1 d3 d4)
		 (setq d3(polar d3 0 10) d4(polar d4 0 10))(n_lin1 d3 d4)
		 (setq d3(list (+ (car d1) 4) (- (cadr d1) 5.5)))
		 (n_text d3 3.5 0 "编" 1)
		 (n_text (polar d3 pi3 5) 3.5 0 "号" 1)
		 (setq d3 (polar d3 0 10))
		 (n_text d3 3.5 0 "直径" 1)
		 (n_text (polar d3 pi3 5) 3.2 0 "(mm)" 1)
		 (setq d3 (polar d3 0 14))
		 (n_text d3 3.5 0 "每根长度" 1)
		 (n_text (polar d3 pi3 5) 3.2 0 "(cm)" 1)
		 (setq d3 (polar d3 0 13))
		 (n_text d3 3.5 0 "根数" 1)
		 (n_text (polar d3 pi3 5) 3.2 0 "(根)" 1)
		 (setq d3 (polar d3 0 13))
		 (n_text d3 3.5 0 "共长" 1)
		 (n_text (polar d3 pi3 5) 3.2 0 "(m)" 1)
		 (setq d3 (list (+ (car d1) 4) (- (cadr d1) 15.8)))
		 (setq i 1)
		 (repeat sphs
			(n_text d3 2 0 (itoa i) 1)
			(setq d3 (polar d3 pi3 bg_a) i (+ i 1))
		 )
		 (if hbg_1 (ds (ppt jd -17 -17.8) hbg_1 -1))
		 (if hbg_2 (ds (ppt jd -3 -17.8) hbg_2 1))
		 (if hbg_3 (ds (ppt jd 10 -17.8) hbg_3 0))
		 (if (and hbg_2 hbg_3)(setq hbg_4(dv (mapcar '* hbg_2 hbg_3) 100)))
		 (if hbg_4 (ds (ppt jd 23 -17.8) hbg_4 2))
		 (if hbg_4 (setq hbg_4(mapcar '(lambda (x) (read (rtos x 2 2))) hbg_4)))
		 (n_endb)
)
(defun zhd_jd(pt1 pt0 jd0 zj / pt00 pt01 ptl pti0 pti1 dis)
    (setq pt00(polar pt0 jd0 10)
	  pt01(polar pt0 (+ jd0 zj) 10)
	  ptl(polar pt1 0 10)
	  pti0(inters pt0 pt00 pt1 ptl nil)
	  pti1(inters pt0 pt01 pt1 ptl nil))
    (polar pti1 (angle pti0 pt1) (distance pti0 pt1))
)

(defun zhjd_text(e pt0 jd0 zj / ptc e1)
    (setq e1(entget e) ptc(cdr (assoc 10 e1)))
    (command "move" e "" ptc (zhd_jd ptc pt0 jd0 zj))
)
(defun zhjd_l(e pt0 jd0 zj / pts pte e1)
    (setq e1(entget e) pts(cdr (assoc 10 e1)) pte(cdr (assoc 11 e1))
	  e1(subst (cons 10 (zhd_jd pts pt0 jd0 zj)) (assoc 10 e1) e1)
	  e1(subst (cons 11 (zhd_jd pte pt0 jd0 zj)) (assoc 11 e1) e1)
    )
    (entmod e1)
)
(defun zhjd_pl(e pt0 jd0 zj)
    (if (assoc 90 (entget e))
        (zhjd1_pl e pt0 jd0 zj)
        (zhjd0_pl e pt0 jd0 zj)
    )
)
(defun zhjd0_pl(e pt0 jd0 zj / pt1 ee ee1)
;R12版
    (setq ee(entnext e) ee1(entget ee))
    (while (/= (cdr (assoc 0 ee1)) "SEQEND")
	(setq pt1(cdr (assoc 10 ee1))
	      ee1(subst (cons 10 (zhd_jd pt1 pt0 jd0 zj)) (assoc 10 ee1) ee1)
	)
	(entmod ee1)
	(setq ee(entnext ee) ee1(entget ee))
    )
    (entupd e)
)
(defun zhjd1_pl(e pt0 jd0 zj / pt1 ee n i k1)
;R14版
    (setq ee(entget e) n(cdr (assoc 90 ee)) i 0
        k1(assoc 10 ee) k1(member k1 ee)
    )
    (repeat n
        (setq pt1(cdr (nth (* i 4) k1))
              ee(subst (cons 10 (zhd_jd pt1 pt0 jd0 zj)) (nth (* i 4) k1) ee)
        )
        (entmod ee)
        (setq i(1+ i))
    )
)
(defun zhd_bl(pt1 pt0 bl_x bl_y / d_x d_y)
    (if (<= bl_x 0) (setq bl_x 1))
    (if (<= bl_y 0) (setq bl_y 1))
    (setq d_x(* (- (car pt1)(car pt0)) bl_x)
	  d_y(* (- (cadr pt1)(cadr pt0)) bl_y))
    (ppt pt0 d_x d_y)
)
(defun zhbl_text(e pt0 bl_x bl_y / ptc e1)
    (setq e1(entget e) ptc(cdr (assoc 10 e1)))
    (command "move" e "" ptc (zhd_bl ptc pt0 bl_x bl_y))
)
(defun zhbl_l(e pt0 bl_x bl_y / pts pte e1)
    (setq e1(entget e) pts(cdr (assoc 10 e1)) pte(cdr (assoc 11 e1))
	  e1(subst (cons 10 (zhd_bl pts pt0 bl_x bl_y)) (assoc 10 e1) e1)
	  e1(subst (cons 11 (zhd_bl pte pt0 bl_x bl_y)) (assoc 11 e1) e1)
    )
    (entmod e1)
)
(defun zhbl_pl(e pt0 bl_x bl_y / pt1 ee ee1)
    (setq ee(entnext e) ee1(entget ee))
    (while (/= (cdr (assoc 0 ee1)) "SEQEND")
	(setq pt1(cdr (assoc 10 ee1))
	      ee1(subst (cons 10 (zhd_bl pt1 pt0 bl_x bl_y)) (assoc 10 ee1) ee1)
	)
	(entmod ee1)
	(setq ee(entnext ee) ee1(entget ee))
    )
    (entupd e)
)

(defun c:asc( / ss e1 nn i f t)
    (print "\n选择需要输出的文本:")
    (setq ss(ssget) i 0)
    (if ss(setq nn(sslength ss))(setq nn 0))
    (setq f(open "t1.txt" "w"))
    (repeat nn
	(setq e1(entget (ssname ss i)) i(+ i 1))
	(if (= (cdr (assoc 0 e1)) "TEXT")
	    (progn
		(setq t(cdr (assoc 1 e1)))
		(write-line t f)
	    )
	)
    )
    (close f)
)
(defun c:zhjd(/ ss e n len pt0 jd0 zj e1)
    (setq n 0)
    (print "\n选择要转换角度的实体:")(setq ss(ssget))
    (if ss (setq len(sslength ss)) (setq ss 0))
    (if ss (progn
    (setq pt0(getpoint "\n输入基点:")
	      jd0(getangle "\n输入基准角度:" pt0)
          zj(getangle "\n输入转换角度(逆时针为正):"))
	)
    )
    (repeat len
	(setq e(ssname ss n) e1(entget e)n(1+ n))
	(cond ((= (cdr (assoc 0 e1)) "LINE")
	       (zhjd_l e pt0 jd0 zj))
          ((or (= (cdr (assoc 0 e1)) "POLYLINE")(= (cdr (assoc 0 e1)) "LWPOLYLINE"))
	       (zhjd_pl e pt0 jd0 zj))
	      ((= (cdr (assoc 0 e1)) "TEXT")
	       (zhjd_text e pt0 jd0 zj))
	      ((= (cdr (assoc 0 e1)) "ARC")
	       (zhjd_text e pt0 jd0 zj))
	)
    )
)
(defun c:zhbl(/ ss e n len pt0 bl_x bl_y e1)
    (setq n 0)
    (print "\n选择要转换比例的实体:")(setq ss(ssget))
    (if ss (setq len(sslength ss)) (setq len 0))
    (if ss (progn
	(initget 1)
    (setq pt0(getpoint "\n基点:")
          bl_x(getreal "\n水平比例<1>:")
          bl_y(getreal "\n竖直比例<缺省与水平比例相同>:")
	)
	(if (not bl_x) (setq bl_x 1))
	(if (not bl_y) (setq bl_y bl_x))
       )
    )
    (repeat len
	(setq e(ssname ss n) e1(entget e)n(1+ n))
	(cond ((= (cdr (assoc 0 e1)) "LINE")
	       (zhbl_l e pt0 bl_x bl_y))
          ((or (= (cd