b.lsp

此代码为Lisp语言编写

	(if (= ff_a "]")
		(progn
			(setq s (substr s 1 (- n_a 1)))
			(sts s)
		)
		s
	)
)
(defun bj__a(al / loop1)
;将度数al化到[0,360)之间.
	(setq loop1 "T")
	(while loop1
		(cond ((and (>= al 0) (< al 360))
			   (setq loop1 nil))
			  ((>= al 360) (setq al(- al 360)))
			  ((< al 0)(setq al(+ al 360)))
		)
	)
	al
)
(defun bjr__a(al / loop1)
;将弧度al化到[0,2*pi)之间.
	(setq loop1 "T")
	(while loop1
		(cond ((and (>= al 0) (< al (* 2 pi)))
			   (setq loop1 nil))
			  ((>= al (* 2 pi)) (setq al(- al pi pi)))
			  ((< al 0)(setq al(+ al pi pi)))
		)
	)
	al
)
(defun stv(str / n[] loop_a i_a ni_a co_a pco+- pco pco*/ s1_a s2_a sc_a e vv)
;将字符串转化为数
;字符串中可含数学表达式.
	(setq str(ss0__a str) pco+- 0 pco 0 pco*/ 0)
	(setq loop_a "t" ni_a(strlen str) i_a ni_a)
	(while (and loop_a (> i_a 0))
		(setq co_a(substr str i_a 1) n[] 1)
		(if (= (strcase co_a) "X") (setq co_a "*"))
		(if (= co_a ")")
			(while (and (> n[] 0) (> i_a 1))
				(setq i_a(1- i_a) co_a(substr str i_a 1))
				(if (= co_a ")") (setq n[](+ 1 n[])))
				(if (= co_a "(") (setq n[] (- n[] 1)))
			)
		)
		(if (member  co_a '("+" "-"))
			(setq pco i_a pco+- i_a)
		)
		(if (and (member  co_a '("*" "/")) (= pco+- 0)(= pco 0))
			(setq pco i_a pco*/ i_a)
		)
		(if (and (member  co_a '("^")) (= pco+- 0)(= pco*/ 0)(= pco 0))
			(setq pco i_a)
		)
		(if (or (> pco+- 0) (and (> pco 0) (= i_a 1)))
			(progn
				(setq s1_a(substr str 1 (- pco 1))
					  s2_a(substr str (+ pco 1) (- ni_a pco))
					  co_a (substr str pco 1)
					  s1_a(stv s1_a) s2_a(stv s2_a)
				)
				(if (= (strcase co_a) "X") (setq co_a "*"))
				(if (and s1_a s2_a)
					(progn
						(if (= co_a "^")
							(setq sc_a(list 'expt (* 1.0 s1_a) (* 1.0 s2_a)))
							(setq sc_a(list (read co_a) (* 1.0 s1_a) (* 1.0 s2_a)))
						)
						(setq vv(eval sc_a) loop_a nil)
					)
				)
			)
		)
		(setq i_a(1- i_a))
	)
	(cond
		((and (= ( strcase(substr str 1 3)) "LBB") loop_a)
		 (setq e(handent (substr str 4 (- ni_a 3))))
		 (if e(setq e(entget e '("LBB_JS"))))
		 (cond ((assoc -3 e)
				(stv (cdr (nth 1 (nth 1 (assoc -3 e)))))
			   )
			   (e
				(stv (cdr (assoc 1 e)))
			   )
		 );end of cond
		) ;end of and
		((and (= ( strcase(substr str 1 4)) "SIN(")(= ( strcase(substr str ni_a 1)) ")")loop_a)
		 (eval (list 'sin (stv (substr str 4))))
		) ;end of and
		((and (= ( strcase(substr str 1 4)) "INT(")(= (strcase(substr str ni_a 1)) ")")loop_a)
		 (eval (list 'fix (stv (substr str 4))))
		) ;end of and
		((and (= ( strcase(substr str 1 4)) "COS(")(= (strcase(substr str ni_a 1)) ")")loop_a)
		 (eval (list 'cos (stv (substr str 4))))
		) ;end of and
		((and (= ( strcase(substr str 1 4)) "TAN(")(= (strcase(substr str ni_a 1)) ")")loop_a)
		 (eval (list 'tan (stv (substr str 4))))
		) ;end of and
		((and (= ( strcase(substr str 1 5)) "SQRT(")(= ( strcase(substr str ni_a 1)) ")")loop_a)
		 (eval (list 'sqrt (stv (substr str 5))))
		) ;end of and
                ((and (= ( strcase(substr str 1 4)) "DTR(")(= ( strcase(substr str ni_a 1)) ")")loop_a)
                 (eval (list 'dtr (stv (substr str 4))))
		) ;end of and
		(loop_a
		 (eval (read str))
		) ;end of loop_a
		(t
		 vv
		) ;end of t
	) ;end of cond
)
(defun sts(str / loop_a n[] i_a ni_a co_a s1_a s2_a sc_a)
	(setq loop_a "t" i_a 1 ni_a(strlen str) n[] 1)
	(while (and loop_a (<= i_a (- ni_a 1)))
		(setq co_a(substr str i_a 1))
		(if (= co_a "*") (setq co_a "x"))(if (= co_a "(")
			(while (and (> n[] 0) (< i_a ni_a))
				(setq i_a(1+ i_a) co_a(substr str i_a 1))
				(if (= co_a "(") (setq n[](+ 1 n[])))
				(if (= co_a ")") (setq n[](- n[] 1)))
			)
		)
		(if (member  co_a '("+" "x" "/"))
			(setq s1_a(substr str 1 (- i_a 1))
				  s2_a(substr str (+ i_a 1) (- ni_a i_a))
				  loop_a nil s1_a(sts s1_a) s2_a(sts s2_a)
				  vv(strcat s1_a co_a s2_a)
			)
		)
		(setq i_a(+ i_a 1))
	)
	(if loop_a (ss__a str) vv)
)
(defun stl(s / n_a n[] st_a se_a ss_a co_a ll_a)
;字符串转化为表,表中各项为字符串.
;","或" "为分隔符
	(setq n_a(strlen s) st_a 1 se_a 1)
	(while (<= se_a n_a)
		(setq co_a(substr s se_a 1) n[] 1)
		(if (= co_a "(")
			(while (and (> n[] 0) (<= se_a n_a))
				(setq se_a(1+ se_a) co_a(substr s se_a 1))
				(if (= co_a "(") (setq n[](1+ n[])))
				(if (= co_a ")") (setq n[](1- n[])))
			)
		)
		(cond ((or (= co_a " ") (= co_a ","))
			   (setq ss_a(substr s st_a (- se_a st_a))
					 st_a(+ 1 se_a) ll_a(cons ss_a ll_a))
			  )
		)
		(setq se_a(+ 1 se_a))
	)
	(setq ll_a(cons (substr s st_a (+ 1 (- se_a st_a))) ll_a))
	(reverse ll_a)
)
(defun sltvl(sl bl)
;将字符串表转化为数值表.
	(mapcar '(lambda (x) (/ (stv x) bl)) sl)
)
(defun vltdl(vl)
;根据vl中数值确定标注控制参数.
;-1:外侧;1:大于内标注长;2:小于内标注长.
	(append '(-1) (mapcar '(lambda (x) (if (< x bznc) 2 1)) vl) '(-1))
)
(defun gjdj(jd zj al / yc cb cb1 cb2 ct dj)
    (if (> zj yjgzj) (setq dj 2) (setq dj 1))
    (setq al (dtr al) yc(polar jd pi (* bzg 0.6)))
    (setq ct(polar yc (- pi2 (dtr 5)) (/ bzg 2)))
    (setq cb(polar ct (+ pi (- pi2 (dtr 5))) bzg))
    (command "text" "m" yc (- bzg (* sca_a 0.2)) 90 "o")
	(command "line" cb ct "")
	(cond ((= dj 2)
		   (setq cb1(polar cb pi (* 0.5 sca_a)) cb2(polar cb 0 (* 0.5 sca_a)))
		   (command "line" cb1 cb2 "")
		  )
	)
    (setq yc(polar jd 0 (* 0.2 bzg)))
    (command "text" "ml" yc bzg 0 (rtos zj 2 0))
)
(defun hbz1(jd gjds gjjj gjbh jd1 jd2 bl / gjbhl al_a l1_a lx pt1 pt2 n_a ptc)
        (setq lx(distance jd jd1)
              al_a(angle jd1 jd2)
        )
        (setq l1_a(stsl gjjj (- gjds 1)) l1_a(mapcar '(lambda (x) (/ x bl 0.1)) l1_a))
        (setq n_a 1)
        (while (<= n_a gjds)
                (setq lx(vln l1_a (- n_a 1)))
                (setq pt1 (polar jd al_a lx))
                (setq pt2 (polar jd1 al_a lx))
        (command "line" pt1 pt2 "")
		(setq n_a (+ n_a 1))
	)
	(if (= (type gjbh) 'str)
		(setq gjbhl(stl gjbh))
		(setq gjbhl(stl (rts gjbh)))
	)
        (command "line" jd1 jd2 "")
        (setq ptc(polar jd2 al_a gbr))
	(command "circle" ptc gbr)
        (command "text" "m" ptc bzg 0 (nth 0 gjbhl))
        (setq n_a 1)
	(if (> (length gjbhl) 1)
            (repeat (- (length gjbhl) 1)                                        
                (setq ptc(polar ptc al_a (* gbr 2)))
                (command "circle" ptc gbr "text" "M" ptc bzg 0 (nth n_a gjbhl))
                (setq n_a(1+ n_a))
            )
        )
)

(defun hbz2(jd gjgs gjjj gjbh al1 ly bl / gjbhl al_a l1_a tl pt1 ptc n_a jd1 jd2)
	(grtext -2 "HBZ2")
	(setq al_a(dtr al1))
	(setq l1_a(stsl gjjj (- gjgs 1)) l1_a(mapcar '(lambda (x) (/ x bl 0.1)) l1_a))
	(if (> ly 0) (setq tl(+ (apply '+ l1_a) ly)) (setq tl(abs ly)))
	(setq pt1(polar jd al_a tl))
	(setq ptc(polar pt1 al_a gbr))
	(if (= (type gjbh) 'str)
		(setq gjbhl(stl gjbh))
		(setq gjbhl(stl (rts gjbh)))
	)
	(command "circle" ptc gbr)
        (command "text" "M" ptc bzg 0 (nth 0 gjbhl))
        (setq n_a 1)
	(if (> (length gjbhl) 1)
            (repeat (- (length gjbhl) 1)
                (setq ptc(polar ptc al_a (* gbr 2)))
                (command "circle" ptc gbr "text" "M" ptc bzg 0 (nth n_a gjbhl))
                (setq n_a(1+ n_a))
            )
        )
	(command "line" pt1 jd "")(setq n_a 1)
	(while (<= n_a gjgs)
		(setq jd1(polar jd al_a (vln l1_a (- n_a 1))))
		(setq jd2(polar jd1 al_a bzjc))
		(command "pline" jd1 "W" 0 bzjk jd2 "")
		(setq n_a (1+ n_a))
	)
)
(defun hbzd(jd gjgs gjjj gjbh al1 ly bl / gjbhl al_a l1_a tl pt1 ptc n_a jd1 jd2)
  ;用圆点代替箭头
	(grtext -2 "HBZ2")
	(setq al_a(dtr al1))
	(setq l1_a(stsl gjjj (- gjgs 1)) l1_a(mapcar '(lambda (x) (/ x bl 0.1)) l1_a))
	(if (> ly 0) (setq tl(+ (apply '+ l1_a) ly)) (setq tl(abs ly)))
	(setq pt1(polar jd al_a tl))
	(setq ptc(polar pt1 al_a gbr))
	(if (= (type gjbh) 'str)
		(setq gjbhl(stl gjbh))
		(setq gjbhl(stl (rts gjbh)))
	)
	(command "circle" ptc gbr)
        (command "text" "M" ptc bzg 0 (nth 0 gjbhl))
        (setq n_a 1)
	(if (> (length gjbhl) 1)
            (repeat (- (length gjbhl) 1)
                (setq ptc(polar ptc al_a (* gbr 2)))
                (command "circle" ptc gbr "text" "M" ptc bzg 0 (nth n_a gjbhl))
                (setq n_a(1+ n_a))
            )
        )
	(command "line" pt1 jd "")(setq n_a 1)
	(while (<= n_a gjgs)
		(setq jd1(polar jd al_a (vln l1_a (- n_a 1))))
		(setq jd2(polar jd1 al_a bzjc))
		(command "donut" 0 (* sca_a 0.7) jd1 "")
		(setq n_a (1+ n_a))
	)
)
(defun hbz3(jd gjds gjjj gjbh zy bl / al_a y1 yj l1_a tl pt1 pt2 pt3 ptc n_a jd1)
	(grtext -2 "HBZ3")
	(setq al_a(- pi (* pi zy)))
	(setq y1(cadr jd))
	(setq l1_a(stsl gjjj (- gjds 1)) l1_a(mapcar '(lambda (x) (/ x bl 0.1)) l1_a))
	(setq tl(apply '+ l1_a))
	(setq yj(- y1 (/ tl 2.0)))
	(setq pt1(list (car jd) yj))
	(setq pt2(polar pt1 al_a gbc31))
	(setq pt3(polar pt2 al_a gbc32))
	(setq ptc(polar pt3 al_a gbr))
	(command "circle" ptc gbr)
    (command "text" "M" ptc bzg 0 gjbh)
	(command "line" pt3 pt2 "")
	(setq n_a 1)
	(while (<= n_a gjds)
		(setq jd1(polar jd pi3 (vln l1_a (- n_a 1))))
		(command "line" pt2 jd1 "")
		(setq n_a (1+ n_a))
	)
)
(defun hbz4(jd gjgs gjzz gjcd gjbh pt1 / al1 pt2 ptz1 ptz2 ptz3 ptc gjbhl)
	(grtext -2 "HBZ4")
    (if (< (car pt1) (car jd))(setq al1 pi)(setq al1 0))
	(setq pt2(polar pt1 al1 gbc4))
    (setq ptz1(polar pt1 al1 (/ gbc4 2)))
    (setq ptz2(polar ptz1 pi2 (+ (/ bzg 2) (* 1.5 bzjj))))
	(command "pline" pt2 "W" 0.0 0.0 pt1 jd "")
	(if (> gjgs 0)
            (gjdj (polar ptz2 0 (* bzg 0.6)) gjzz 0)
            (gjdj (polar ptz2 pi (* bzg 0.2)) gjzz 0)
        )
	(setq ptz3(polar ptz1 pi3 (+ bzjj bzg)))
    (command "text" "C" ptz3 bzg 0 (rts gjcd))
	(cond ((> gjgs 0)
		   (setq ptz4(polar ptz1 pi2 (* 1.5 bzjj)))
		   (setq ptz4(polar ptz4 pi (+ bzjj (/ bzg 2))))
           (command "text" "r" ptz4 bzg 0 gjgs)
		  )
	)
	(if (= (type gjbh) 'str)
		(setq gjbhl(stl gjbh))
		(setq gjbhl(stl (rts gjbh)))
	)
	(setq ptc(polar pt2 al1 gbr))
	(command "circle" ptc gbr)
    (command "text" "m" ptc bzg 0 (nth 0 gjbhl))
    (setq n_a 1)
	(if (> (length gjbhl) 1)
            (repeat (- (length gjbhl) 1)
                (setq ptc(polar ptc al1 (* gbr 2)))
                (command "circle" ptc gbr "text" "M" ptc bzg 0 (nth n_a gjbhl))
                (setq n_a(1+ n_a))
            )
     )

)
(defun hbz5(jd hs ls gjbh / l1_a l2_a pt1 ptc sl n_a m jd1 jd2 ni)
	(grtext -2 "HBZ5")
	(setq l1_a(* gbjc ls))
	(setq l2_a(* gbjc hs))
	(setq pt1(polar jd pi (/ l1_a 2)))
	(setq ptc(polar pt1 0 (/ gbjc 2)))
	(setq ptc(polar ptc pi2 (+ (* gbjc (- hs 1)) (/ gbjc 2))))
	(setq sl(stl gjbh))
	(setq n_a 0)
	(while (<= n_a hs)
		(setq jd1(polar pt1 pi2 (* gbjc n_a)))
		(setq jd2(polar jd1 0 l1_a))
		(command "line" jd1 jd2 "")
		(setq n_a(1+ n_a))
	)
	(setq n_a 0)
	(while (<= n_a ls)
                (setq jd1(polar pt1 0 (* gbjc n_a)))
		(setq jd2(polar jd1 pi2 l2_a))
		(command "line" jd1 jd2 "")
		(setq n_a(1+ n_a))
	)
	(setq n_a 1)
	(while (<= n_a hs)
		(setq jd1(polar ptc pi3 (* gbjc (- n_a 1))))
		(setq m 1)
		(while (<= m ls)
			(setq ni(+ (* (- n_a 1) ls) m -1))
			(setq jd2(polar jd1 0 (* gbjc (- m 1))))
	    (command "text" "M" jd2 bzg 0 (nth ni sl))
			(setq m(1+ m))
		)
		(setq n_a(1+ n_a))
	)
)
(defun dim0(jd bzc bzf al jj lf rf / jf mf a1 a b zy zy0 jdy pt1 pt2 ptc w svr)
	(if (> bzc bznc) (setq mf 1) (setq mf 2))
	(setq w(cdr (assoc 41 (tblsearch "style" (getvar "textstyle")))))
	(setq a1(bj__a al))