BG4标高自动标注4下右.LSP
上传用户:sd555111
上传日期:2014-05-17
资源大小:31k
文件大小:2k
源码类别:

CAD

开发平台:

MathCAD

  1. ;       =============================================
  2. ;       |             标高自动标注软件              |
  3. ;       |         版本: V1.1   作者: 尉迟俊岭       |
  4. ;       =============================================
  5. (defun C:bg4(/ dx dy dx1 dx2 dx3 dy1 pt dxt dyt 
  6.                lay pt1 pt2 pt3 pt4 pt5 ptt scale)
  7.   (setvar "CMDECHO" 0)
  8.   (setq lay (getvar "clayer"))
  9.   (command "color" "bylayer")
  10.   (command "layer" "m" "bg" "c" "yellow" "bg" "")
  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.   (if (= scab nil) (setq scab 1.0))
  17.   (setq scale (getreal (strcat "n等比缩放值 <" (rtos scab 2 0) ">:")))
  18.     (if (= scale nil) (setq scale scab))
  19.     (setq scab scale)
  20.   (setvar "osmode" 512)
  21.   (setq pt (getpoint "n指定插入点 <nea mode>: "))
  22.   (setvar "osmode" 0)
  23.     (setq dy (cadr pt))
  24.     (setq dx (car pt))
  25.       (setq dx1 (- dx (* 3 scale)))
  26.       (setq dx2 (+ dx (* 3 scale)))
  27.       (setq pt1 (list dx1 dy)) 
  28.       (setq pt2 (list dx2 dy))
  29.         (command "line" pt1 pt2 "")  
  30.       (setq dy1 (- dy (* 3 scale)))
  31.       (setq pt3 (list dx1 dy1)) 
  32.         (command "line" pt pt3 "")  
  33.       (setq pt4 (list dx2 dy1))
  34.         (command "line" pt pt4 "")  
  35.       (setq dx3 (- dx (* 13 scale)))
  36.       (setq pt5 (list dx3 dy1))
  37.         (command "line" pt4 pt5 "")  
  38.       (setq dxt (+ dx3 (* 2 scale)))
  39.       (setq dyt (- dy1 (* 4.15 scale)))
  40.       (setq txt 0)
  41.       (setq high (* 3 scale))
  42.       (while (/= txt nil) 
  43.         (setq txt (getreal "n标注文字说明:"))  
  44.           (if (/= txt nil)
  45.             (progn
  46.               (setq ptt (list dxt dyt))
  47.               (setq txt1 (rtos txt 2 3))
  48.               (command "text" "s" "xw" ptt high "0" txt1)
  49.               (setq dyt (- dyt (* 4.15 scale)))
  50.             )
  51.           )
  52.       )
  53.   (command "layer" "s" lay "")
  54.   (princ)(princ)
  55. )