[LISP程序]：一个修改线段宽度的程序

rdhhb

[php]

(setq sj 0.6)  ;初始化数值
(defun c:er (/ sdg ddx aaa tjxglist)
  (graphscr)
  (setq sdg (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  ;(setq kuandu kd)  
  (setq kuandustr (rtos sj))
  ;(initget "A")
  (setq aaa (getreal (strcat "\n〖默认宽度："kuandustr" mm‖回车为默认宽度〗或输入数值:")))
  (while
    (setq tjxglist
           '((-4 . "<or")
            (-4 . "<and")
            (0 . "ARC")
            (-4 . "and>")
            (-4 . "<and")
            (0 . "LWPOLYLINE")
            (-4 . "and>")
            (-4 . "<and")
            (0 . "line")
            (-4 . "and>")
            (-4 . "or>"))
        )
  (if aaa
    (progn      
      (setq ddx (ssget tjxglist))
      ;(setq sl (rtos (sslength ddx)))
      (if (not ddx)
        (VL-EXIT-WITH-ERROR (princ "*未选择对象或选择错误！对象包括：圆弧，直线，多段线*")))
      (vl-cmdf "_.pedit" "m" ddx "" "w" aaa "")
      (setq ggo (rtos aaa))
      (setq kuandustr (rtos aaa))
      (setq sj aaa)
      (princ (STRCAT "\n修改成功，现在宽度为：" ggo " 毫米"))(print)
      )
    (progn
      (setq ddx (ssget tjxglist))
      (if (not ddx)
        (VL-EXIT-WITH-ERROR (princ "*未选择对象或选择错误！对象包括：圆弧，直线，多段线*"))
        )
      ;(setq sl (rtos (sslength ddx)))
      (progn (vl-cmdf "_.pedit" "m" ddx "" "w" sj "")(setq ggo (rtos sj)))
      (princ (STRCAT "\n修改成功，现在宽度为：" ggo " 毫米"))(print)
             )
    ))
  ;;(if (not ddx)
  ;;  (progn (alert "\n对不起,您未选择多段线，请重试！")(print)(VL-EXIT-WITH-ERROR ""));(VL-EXIT-WITH-ERROR "") ;
  ;;  (progn (princ (STRCAT "\n修改成功，现在宽度为：" ggo " 毫米"))(print))
  ;;  )
  (setvar "cmdecho" sdg)
  (princ))
[/php]