GL8过梁自动绘标8下右.LSP
上传用户:sd555111
上传日期:2014-05-17
资源大小:31k
文件大小:3k
源码类别:

CAD

开发平台:

MathCAD

  1. ;       =============================================
  2. ;       |             过梁自动标注软件              |
  3. ;       |         版本: V1.1   作者: 尉迟俊岭       |
  4. ;       =============================================
  5. (defun C:gl8(/ dx dy dy1 dy2 dy3 dy4 dy5 dy6 dy7 dy8 dx1 dx2 pt dxt dyt qt dxz
  6.   scale txt high lay pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt8 pt10 ptt dis with tt c)
  7.   (setvar "CMDECHO" 0)
  8.   (setq lay (getvar "clayer"))
  9.   (command "color" "bylayer")
  10.   (command "layer" "m" "gl" "c" "m" "gl" "")
  11.   (if (or (= nil (tblsearch "style" "xw"))
  12.           (/= (cdr (assoc 40 (tblsearch "style" "xw"))) 0)
  13.       )
  14.     (command "STYLE" "xw" "txt" "0" ".8" "0" "n" "n" "n")
  15.   )
  16.   (command "osnap" "int")
  17.   (setq pt (getpoint "n指定插入点(标注在插入点的下右方) <int mode>: "))
  18.   (command "osnap" "non")
  19.   
  20.   (if (= scab nil) (setq scab 1.0))
  21.   (princ "n比例值取1到100之间任意数 !")
  22.   (setq scale (getreal (strcat "n输入比例数值 <" (rtos scab 2 0) ">:")))
  23.     (if (= scale nil) (setq scale scab))
  24.     (setq scab scale)
  25.   (if (= nil d) (setq d 240.0))
  26.   (setq dis (getreal (strcat "n输入到插入点的距离 <" (rtos d 2 0) ">:")))
  27.   (if (= nil dis) (setq dis d))
  28.   (setq d dis dis (* (/ dis 100.0) scale))
  29.   
  30.   (if (= nil w) (setq w 900.0))
  31.   (setq with (getreal (strcat "n输入墙壁的厚度 <" (rtos w 2 0) ">:")))
  32.   (if (= nil with) (setq with w))
  33.   (setq w with with (* (/ with 100.0) scale))
  34.   
  35.   (if (= nil q) (setq q 240.0))
  36.   (setq qt (getreal (strcat "nThickness of wall <" (rtos q 2 0) ">:")))
  37.   (if (= nil qt) (setq qt q))
  38.   (setq q qt qt (* (/ qt 100.0) scale))
  39.     (setq dy (cadr pt))
  40.     (setq dx (car pt))
  41.       (setq dy2 (- dy dis))
  42.       (setq dy1 (- dy2 with))
  43.       (setq dx2 (- dx (* 0.6 scale)))
  44.       (setq dx1 (+ (+ dx2 qt) (* 1.2 scale)))
  45.       (setq pt1 (list dx1 dy1)) 
  46.       (setq pt2 (list dx2 dy1))
  47.         (command "line" pt1 pt2 "")  
  48.       (setq pt3 (list dx1 dy2)) 
  49.       (setq pt4 (list dx2 dy2))
  50.         (command "line" pt3 pt4 "")  
  51.       (setq dy3 (- dy1 (* 2.4 scale)))
  52.       (setq dxz (+ dx (/ qt 2.0)))
  53.       (setq pt5 (list dxz dy3)) 
  54.       (setq tmp (/ (- with (* 3 scale)) 2.0))
  55.       (setq dy4 (+ dy1 tmp))
  56.       (setq pt6 (list dxz dy4))
  57.         (command "pline" pt5 "w" (* 0.6 scale) (* 0.6 scale) pt6 "")  
  58.       (setq dy5 (+ dy4 (* 1 scale)))
  59.       (setq dy6 (+ dy5 (* 1 scale)))
  60.       (setq pt7 (list dxz dy5))
  61.       (setq pt8 (list dxz dy6))
  62.         (command "pline" pt7 "w" (* 0.6 scale) (* 0.6 scale) pt8 "") 
  63.       (setq dy7 (+ dy6 (* 1 scale)))
  64.       (setq dy8 (+ dy2 (* 2.4 scale)))
  65.       (setq pt9 (list dxz dy7))
  66.       (setq pt10 (list dxz dy8))
  67.         (command "pline" pt9 "w" (* 0.6 scale) (* 0.6 scale) pt10 "") 
  68.       (setq dxt (+ dx1 (* 4.9 scale)))
  69.       (setq dyt (+ dy5 (* 0.5 scale)))
  70.       (setq txt "0")
  71.       (setq high (* 4 scale))
  72.       (setq tt (strcat (rtos (/ qt (* 1.2 scale)) 2 0) "GL" (rtos (/ with scale) 2 0) ".4"))
  73.       (setq c 1)
  74.       (while (/= txt "") 
  75.         (setq txt (getstring (strcat "n输入标注文字 <" tt ">:")))
  76.         (if (and (= txt "") (= c 1)) (setq txt tt))
  77.         (setq c nil tt "None")
  78.           (if (/= txt "")
  79.             (progn
  80.               (setq ptt (list dxt dyt))
  81.               (command "text" "s" "xw" "c" ptt high "90" txt)
  82.               (setq dxt (+ dxt (* 5.15 scale)))
  83.             )
  84.           )
  85.       )
  86.   (command "layer" "s" lay "")
  87.   (princ)(princ)
  88. )