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

CAD

开发平台:

MathCAD

  1. ;       =============================================
  2. ;       |             过梁自动标注软件              |
  3. ;       |         版本: V1.1   作者: 尉迟俊岭       |
  4. ;       =============================================
  5. (defun C:gl6(/ dx dy dx1 dx2 dx3 dx4 dx5 dx6 dx7 dx8 dy1 dy2 pt dxt dyt qt dyz
  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 "n输入墙壁的厚度 <" (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 dx2 (- dx dis))
  42.       (setq dx1 (- dx2 with))
  43.       (setq dy2 (+ dy (* 0.6 scale)))
  44.       (setq dy1 (- (- dy2 qt) (* 1.2 scale)))
  45.       (setq pt1 (list dx1 dy1)) 
  46.       (setq pt2 (list dx1 dy2))
  47.         (command "line" pt1 pt2 "")  
  48.       (setq pt3 (list dx2 dy1)) 
  49.       (setq pt4 (list dx2 dy2))
  50.         (command "line" pt3 pt4 "")  
  51.       (setq dx3 (- dx1 (* 2.4 scale)))
  52.       (setq dyz (- dy (/ qt 2.0)))
  53.       (setq pt5 (list dx3 dyz)) 
  54.       (setq tmp (/ (- with (* 3 scale)) 2.0))
  55.       (setq dx4 (+ dx1 tmp))
  56.       (setq pt6 (list dx4 dyz))
  57.         (command "pline" pt5 "w" (* 0.6 scale) (* 0.6 scale) pt6 "")  
  58.       (setq dx5 (+ dx4 (* 1 scale)))
  59.       (setq dx6 (+ dx5 (* 1 scale)))
  60.       (setq pt7 (list dx5 dyz))
  61.       (setq pt8 (list dx6 dyz))
  62.         (command "pline" pt7 "w" (* 0.6 scale) (* 0.6 scale) pt8 "") 
  63.       (setq dx7 (+ dx6 (* 1 scale)))
  64.       (setq dx8 (+ dx2 (* 2.4 scale)))
  65.       (setq pt9 (list dx7 dyz))
  66.       (setq pt10 (list dx8 dyz))
  67.         (command "pline" pt9 "w" (* 0.6 scale) (* 0.6 scale) pt10 "") 
  68.       (setq dyt (- dy1 (* 4.9 scale)))
  69.       (setq dxt (+ dx5 (* 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 "0" txt)
  82.               (setq dyt (- dyt (* 5.15 scale)))
  83.             )
  84.           )
  85.       )
  86.   (command "layer" "s" lay "")
  87.   (princ)(princ)
  88. )