acad.lsp

此代码为Lisp语言编写

(load"b")
(load"bzx")
(load"bzy")
(load"dq")
;(command "-style" ""  "txt,hztxt" "" "0.8" "" "" "" "")
;(command "-style" "hz"  "txt,hztxt" "" "0.8" "" "" "" "")
(command "mirrtext" "0")
(command "acadlspasdoc" "1")
(command "_properties")
(command "zoom" "e")
(command "-linetype" "s" "dashed" "")
(command "-linetype" "s" "center" "")
(command "-linetype" "s" "bylayer" "")
(COMMAND "-LAYER" "MAKE" "中心线层" "COLOR" "3" "中心线层" "ltype" "center" "" "")
(COMMAND "-LAYER" "MAKE" "虚线层" "COLOR" "3" "虚线层" "ltype" "dashed" "" "")
(COMMAND "-LAYER" "MAKE" "图框层" "COLOR" "7" "图框层" "ltype" "continuous" "" "")
(COMMAND "-LAYER" "MAKE" "尺寸标注层" "COLOR" "3" "尺寸标注层" "")
(COMMAND "-LAYER" "MAKE" "文字层" "COLOR" "4" "文字层" "")
(COMMAND "-LAYER" "MAKE" "表格层" "COLOR" "8" "表格层" "")
(COMMAND "-LAYER" "MAKE" "辅助线层" "COLOR" "5" "辅助线层" "")
(COMMAND "-LAYER" "MAKE" "普通钢筋层" "COLOR" "1" "普通钢筋层" "lweight" "0.4" "" "")
(COMMAND "-LAYER" "MAKE" "预应力钢筋层" "COLOR" "1" "预应力钢筋层" "lweight" "0.4" "" "")
(COMMAND "-LAYER" "MAKE" "结构层" "COLOR" "7" "结构层" "")
(command "zoom" "e")

;绘制图框
(defun c:tk ( / wka wkb wkc wkd nka nkb nkc nkd zka zkb1 zkb2 zkc2 zkc1 zkd1 zkd2 zkz2 zkz1 zke1 zke2 zkf2 zkf1 zkg1 zkg2 zkh2 zkh1 zki1 zki2 zkj2 zkj1 zkk1 zkk2 zkl2 zkl1 pt ptf p1)
  (setq svr(getvar "osmode"))
  (setvar "osmode" 0)  
  (COMMAND "-LAYER" "SET" "图框层" "")
  (SETQ wka '(0 0) wkb '(420 0) wkc '(420 297) wkd '(0 297))
  (command "line" wka wkb wkc wkd "close")
  (setq nka '(30 10) nkb '(410 10) nkc '(410 287) nkd '(30 287))
  (command "line" nka nkb nkc nkd "close")
  (setq zka '(30 20) zkb1 '(95 20) zkb2 '(95 10) zkc1 '(160 20) zkc2 '(160 10) zkd1 '(235 20) zkd2 '(235 10) zkz1 '(250 20) zkz2 '(250 10) zke1 '(270 20) zke2 '(270 10) zkf1 '(285 20) zkf2 '(285 10) zkg1 '(305 20) zkg2 '(305 10) zkh1 '(320 20) zkh2 '(320 10) zki1 '(340 20) zki2 '(340 10) zkj1 '(355 20) zkj2 '(355 10) zkk1 '(375 20) zkk2 '(375 10) zkl1 '(390 20) zkl2 '(390 10) zkm '(410 20))
  (command "line" zka zkm "")
  (command "line" zkb1 zkb2 zkc2 zkc1 zkd1 zkd2 zkz2 zkz1 zke1 zke2 zkf2 zkf1 zkg1 zkg2 zkh2 zkh1 zki1 zki2 zkj2 zkj1 zkk1 zkk2 zkl2 zkl1 "")
  ;图框文字
  (COMMAND "-LAYER" "SET" "文字层" "")
  (command "-style" "hz"  "txt,hztxt" "" "0.7" "" "" "" "")
  (setq pt (list 127.5 15))
  (command "text" "j" "m"  pt "4.5" "0" "xxxxxx")
  (command "-style" "hz"  "txt,hztxt" "" "0.8" "" "" "" "")
  (setq pt (list 62.5 15))
  (command "text" "j" "m" pt "4.5" "0" "xxxxxxxxx")  
  (setq pt (list 197.5 12.5))
  (command "-style" "hz"  "txt,hztxt" "" "0.8" "" "" "" "")
  (command "text""j" "m"  pt "3.5" "0" "XX")
  (setq pt (list 197.5 17.5))
  (command "text""j" "m"  pt "3.5" "0" "xxxxxxxx")
  (setq pt (list 242.5 15))
  (command "text""j" "m"  pt "4.5" "0" "设 计")
  (setq pt (list 277.5 15))
  (command "text""j" "m"  pt "4.5" "0" "复 核")
  (setq pt (list 312.5 15))
  (command "text""j" "m"  pt "4.5" "0" "审 核")
  (setq pt (list 347.5 15))
  (command "text""j" "m"  pt "4.5" "0" "图 号")
  (setq pt (list 382.5 15))
  (command "text""j" "m"  pt "4.5" "0" "日 期")
  (setq pt (list 400 15))
  (command "text""j" "m"  pt "3.5" "0" "xxxxxxxx")
  ;注
  ;(setq ptf (list 285.0 60.0))
  ;(command "text" ptf "4" "0" "注：")
  ;(setq p1 (list (+ (car ptf) 8.0) (- (cadr ptf) 5.5)))
  ;(command "text" p1 "3.5" "0" "1.本图尺寸除钢筋直径以mm计外，其余均以cm为单位。")
  ;(setq p1 (list (- (car p1) 1.0) (- (cadr p1) 6.5)))
  ;(command "text" p1 "3.5" "0"  "2.本图比例为1:   。")
  ;满屏显示
  (command "zoom" "e")
  (COMMAND "-LAYER" "SET" "结构层" "")
  (setvar "osmode" svr)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;定义尺寸标注样式
(defun c:bzys ( / bl tm)
	(setq tm (getint "请输入比例:"))
	(command "-dimstyle" "save" tm "")
  	(setq bl (/ tm 10))
  	(command "-style" "hz"  "txt,hztxt" "" "0.8" "" "" "" "")
	(command "dim" "dimasz" "1.8" "dimtad" "1" "dimclrd" "3" "dimclre" "3" "dimclrt"  "3" "dimtxsty" "hz" "dimtxt" "1.8" "dimdli" "1.8" "dimexe" "1.8" "dimexo" "1.8" "dimatfit" "0" "dimtofl" "off" "dimtmove" "2" "dimdec" "0" "dimdsep" "." "dimlfac" bl "dimzin" "1" "dimazin" "0" "exit")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:llj()
  	(setq ent (entlast))
  	(setq ent1 (entget ent))
  	(setq ct 0)
  	(textpage)
  	(princ "\nentget of last entity:")
  	(repeat (length ent1)
	  	(print (nth ct ent1))
	  	(setq ct (1+ ct))
	)
  	(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:tm ( / pt)
  (setq svr(getvar "osmode"))
  (setvar "osmode" 0)  
  (COMMAND "-LAYER" "SET" "文字层" "")
  (command "-style" "hz"  "txt,hztxt" "" "0.8" "" "" "" "")
  (setq pt (list 127.5 15))
  (command "text" "j" "m"  pt "4" "0" "xxxxxxxxxxxxxx")
  (command "-style" "hz"  "txt,hztxt" "" "0.8" "" "" "" "")
  (setq pt (list 62.5 15))
  (command "text" "j" "m" pt "4" "0" "xxxxxxxxxxxxxxxx")  
  (setq pt (list 197.5 17.5))
  (command "text""j" "m"  pt "3.5" "0" "xxxxxxxxxxxxxxxxxxxxxxxx")
  (setvar "osmode" svr)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:hz()
	(command "-style" ""  "txt,hztxt" "" "0.8" "" "" "" "")
	(command "-style" "hz"  "txt,hztxt" "" "0.8" "" "" "" "")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;修改已有文本，标注点坐标X、Y。
(defun c:zb(/ zb1 zbx zby ss ee)
       	(setq zb1 (getpoint"选择坐标点："))
  	(setq zby (rtos(cadr zb1) 2 1))
  	(setq zbx (rtos(car zb1) 2 1))
        (print "\n选择X坐标文本:")
        (setq ss(entsel))
	(setq ee(entget(car ss)))
        (setq ee(subst (cons 1 zbx)(assoc 1 ee) ee))
	(entmod ee)
        (print "\n选择Y坐标文本:")
        (setq ss(entsel))
	(setq ee(entget(car ss)))
	(setq ee(subst (cons 1 zby)(assoc 1 ee) ee))
	(entmod ee)	
 )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;标注该点坐标
(defun c:zbbz(/ jd gjgs gjzz gjcd gjbh zy pf)
       (setq jd(getpoint "\n基点:"))
       (setq pf(getpoint jd "\n标注方向:"))
       (setla "文字层")
       (zbbz0 jd pf)
       (rstla)
)
(defun zbbz0(jd pt1 / al1 al2 pt2 pt3 zbx zby dis1 dis2 svr)
    (setq svr(getvar "osmode"))
    (setvar "osmode" 0)
    (if (< (car pt1) (car jd))
      (setq al2 pi)
      (setq al2 0)
    )
      (if (< (car pt1) (car jd))
           (if  (< (cadr pt1) (cadr jd))
	       	(setq al1 (* 1.25 pi))
		(setq al1 (* 0.75 pi))
	)
           (if  (< (cadr pt1) (cadr jd))
	      (setq al1 (* 1.75 pi))
	      (setq al1 (* 0.25 pi))
	)
    )
	
    (setq dis1(* (abs (- (cadr pt1)(cadr jd))) (sqrt 2)))
    (setq zby (strcat  "Y=" (rtos(cadr jd) 2 3)))
    (setq zbx (strcat "X=" (rtos(car jd) 2 3)))
    (setq dis2(+ (* (max (strlen zbx)(strlen zby)) bzg 0.6) (* 0.5 sca_a)))
    (setq pt2(polar jd al1 dis1) pt3(polar pt2 al2 dis2))
    (command "pline" jd "w" 0 0 pt2 pt3 "")
    (if (< (car pt1) (car jd))
      (setq pt3(polar pt3 0 (* 0.2 sca_a)))
      (setq pt3(polar pt2 0 (* 0.7 sca_a)))
    )
    (command "text" (ppt pt3 0 (* 0.7 sca_a)) bzg 0 zbx)
    (command "text" "tl" (ppt pt3 0 (* -0.7 sca_a)) bzg 0 zby)
    (setvar "osmode" svr)
)
(defun c:bz( / )
;开启捕捉功能
    (setvar "osmode" 759)
)
(defun c:llj()
  	(setq ent (entlast))
  	(setq ent1 (entget ent))
  	(setq ct 0)
  	(textpage)
  	(princ "\nentget of last entity:")
  	(repeat (length ent1)
	  	(print (nth ct ent1))
	  	(setq ct (1+ ct))
	)
  	(princ)
)