[源码]动态粗糙度

lihezhou

不知道VB.net怎么做!

冒个烟圈

终于找到了。。虽然目前以我的水平看不懂源码，但程序非常好用。谢谢楼主分享！！！

w245272914

下载了就过来 顶贴人性化程序，不错赞个~

hawnn

没错，这就是我一直在找的源码
收藏之，谢谢楼主

fangseng

收藏之，谢谢楼主

langjs

这个程序真好用，加入我的工具箱了。修改了一下，把幻灯片和对话框整合到sp里了

;;;; ****************************************************************
;;; *风之影粗糙度绘制，langjs修改
;;; ****************************************************************
(defun c:ccd (/ $value a ang b bname c code dcl_pt dcl_re dclname do dra drb edata ename era erb f kname llist loop myerr
                nearpnt olderr os p00 p1d p1u p2d p2u p3d p3u pcd pcu pqy prcs ptd ptu ra rb scl snappnt value x
             )
  (defun do_list ()
    (start_list "RV" 1)
    (setq value (nth (atoi $value) llist))
    (end_list)
    (set_tile "error" (strcat "粗糙度为 Ra" value))
  )
  (defun myerr (msg)
    (command "undo" "e")
    (setvar "osmode" os)
    (entdel ename)
    (setq *error* olderr)
  )
  (defun image (a b c)
    (if (= a 0)
      (progn
        (start_image "RM")
        (fill_image 0 0 48 48 4)
        (vector_image 20 40 40 5 5)
        (vector_image 20 40 12 26 5)
        (vector_image 28 26 12 26 5)
        (vector_image 20 41 40 6 5)
        (vector_image 20 41 12 27 5)
        (vector_image 28 27 12 27 5)
        (end_image)
      )
      (progn
        (start_image "RM")
        (fill_image 0 0 48 48 5)
        (vector_image 20 40 40 5 7)
        (vector_image 20 40 12 26 7)
        (vector_image 28 26 12 26 7)
        (vector_image 20 41 40 6 7)
        (vector_image 20 41 12 27 7)
        (vector_image 28 27 12 27 7)
        (end_image)
      )
    )
    (if (= b 0)
      (progn
        (start_image "UN")
        (fill_image 0 0 48 48 4)
        (vector_image 20 40 40 5 5)
        (vector_image 20 40 12 26 5)
        (vector_image 20 41 40 6 5)
        (vector_image 20 41 12 27 5)
        (vector_image 18 26 23 26 5)
        (vector_image 17 27 18 27 5)
        (vector_image 23 27 24 27 5)
        (vector_image 16 28 17 28 5)
        (vector_image 24 28 25 28 5)
        (vector_image 16 29 16 32 5)
        (vector_image 25 29 25 32 5)
        (vector_image 16 33 17 33 5)
        (vector_image 24 33 25 33 5)
        (vector_image 17 34 18 34 5)
        (vector_image 23 34 24 34 5)
        (vector_image 18 35 23 35 5)
        (end_image)
      )
      (progn
        (start_image "UN")
        (fill_image 0 0 48 48 5)
        (vector_image 20 40 40 5 7)
        (vector_image 20 40 12 26 7)
        (vector_image 20 41 40 6 7)
        (vector_image 20 41 12 27 7)
        (vector_image 18 26 23 26 7)
        (vector_image 17 27 18 27 7)
        (vector_image 23 27 24 27 7)
        (vector_image 16 28 17 28 7)
        (vector_image 24 28 25 28 7)
        (vector_image 16 29 16 32 7)
        (vector_image 25 29 25 32 7)
        (vector_image 16 33 17 33 7)
        (vector_image 24 33 25 33 7)
        (vector_image 17 34 18 34 7)
        (vector_image 23 34 24 34 7)
        (vector_image 18 35 23 35 7)
        (end_image)
      )
    )
    (if (= c 0)
      (progn
        (start_image "BS")
        (fill_image 0 0 48 48 4)
        (vector_image 20 40 40 5 5)
        (vector_image 20 40 12 26 5)
        (vector_image 20 41 40 6 5)
        (vector_image 20 41 12 27 5)
        (end_image)
      )
      (progn
        (start_image "BS")
        (fill_image 0 0 48 48 5)
        (vector_image 20 40 40 5 7)
        (vector_image 20 40 12 26 7)
        (vector_image 20 41 40 6 7)
        (vector_image 20 41 12 27 7)
        (end_image)
      )
    )
  )
  (defun do_a ()
    (setq value (cadr (member value llist)))
    (if value
      (progn
        (refresh ra)
        (refresh rb)
      )
      (setq value "50")
    )
  )
  (defun do_s ()
    (setq value (cadr (member value (reverse llist))))
    (if value
      (progn
        (refresh ra)
        (refresh rb)
      )
      (setq value "")
    )
  )
  (defun refresh (bname / kname edata)
    (tblnext "block" t)
    (while (/= (cdr (assoc 2 (setq kname (tblnext "block")))) bname))
    (setq edata (entget (cdr (assoc -2 kname))))
    (entmod (subst
              (cons 1 value)
              (assoc 1 edata)
              edata
            )
    )
    (entupd ename)
  )
  (defun create_ra ()
    (entmake (list '(0 . "BLOCK") '(10 0 0 0) '(70 . 1) '(2 . "*U")))
    (entmake (list '(0 . "TEXT") (cons 10 p00) (cons 11 ptu) (cons 7 (getvar "DIMTXSTY")) '(8 . "DIM") '(40 . 2.5) '
                   (62 . 3) '(72 . 4) (cons 1 value)
             )
    )
    (cond
      ((= prcs 1)
        (entmake (list '(0 . "LINE") '(62 . 4) (cons 10 p1u) (cons 11 p2u) '(8 . "DIM")))
      )
      ((= prcs 2)
        (entmake (list '(0 . "CIRCLE") '(62 . 4) (cons 10 pcu) '(40 . 1.33) '(8 . "DIM")))
      )
    )
    (entmake (list '(0 . "LINE") '(62 . 4) (cons 10 p00) (cons 11 p2u) '(8 . "DIM")))
    (entmake (list '(0 . "LINE") '(62 . 4) (cons 10 p00) (cons 11 p3u) '(8 . "DIM")))
    (setq ra (entmake '((0 . "ENDBLK"))))
    (entmake (list '(0 . "INSERT") (cons 10 p00) (cons 41 scl) (cons 42 scl) (cons 2 ra)))
    (setq era (entlast))
    (setq dra (entget era))
  )
  (defun create_rb ()
    (entmake (list '(0 . "BLOCK") '(10 0 0 0) '(70 . 1) '(2 . "*U")))
    (entmake (list '(0 . "TEXT") (cons 10 p00) (cons 11 ptd) (cons 7 (getvar "DIMTXSTY")) '(8 . "DIM") '(40 . 2.5) '
                   (62 . 3) '(72 . 4) (cons 1 value)
             )
    )
    (cond
      ((= prcs 1)
        (entmake (list '(0 . "LINE") '(62 . 4) (cons 10 p1d) (cons 11 p2d) '(8 . "DIM")))
      )
      ((= prcs 2)
        (entmake (list '(0 . "CIRCLE") '(62 . 4) (cons 10 pcd) '(40 . 1.33) '(8 . "DIM")))
      )
    )
    (entmake (list '(0 . "LINE") '(62 . 4) (cons 10 p00) (cons 11 p2d) '(8 . "DIM")))
    (entmake (list '(0 . "LINE") '(62 . 4) (cons 10 p00) (cons 11 p3d) '(8 . "DIM")))
    (setq rb (entmake '((0 . "ENDBLK"))))
    (entmake (list '(0 . "INSERT") (cons 10 p00) (cons 41 scl) (cons 42 scl) (cons 2 rb)))
    (setq erb (entlast))
    (setq drb (entget erb))
  )
  (defun do_left ()
    (setq snappnt (cadr code))
    (entdel ename)
    (if (osnap snappnt "nea")
      (progn
        (entdel ename)
        (create_ra)
        (create_rb)
        (entdel erb)
        (setq ename era)
      )
      (progn
        (entdel ename)
        (setq dra (subst
                    (cons 50 0.0)
                    (assoc 50 dra)
                    dra
                  )
        )
        (setq dra (subst
                    (cons 41 (* 1.25 (cdr (assoc 41 dra))))
                    (assoc 41 dra)
                    dra
                  )
        )
        (setq dra (subst
                    (cons 42 (* 1.25 (cdr (assoc 42 dra))))
                    (assoc 42 dra)
                    dra
                  )
        )
        (entmod dra)
        (entmake (list '(0 . "TEXT") (cons 7 (getvar "DIMTXSTY")) '(8 . "DIM") '(10 0.0 0.0 0.0) (cons 40 (* scl 4.0))
                       (cons 41 0.8) '(62 . 3) '(72 . 4) (cons 11 (mapcar
                                                                    '+
                                                                    (mapcar
                                                                      (function (lambda (x)
                                                                                  (* scl x)
                                                                                )
                                                                      )
                                                                      pqy
                                                                    )
                                                                    snappnt
                                                                  )
                                                         ) '(1 . "其余")
                 )
        )
        (setq loop nil)
      )
    )
  )
  (defun do_right ()
    (setq loop nil)
    (entdel ename)
  )
  (defun do_move ()
    (setq snappnt (cadr code))
    (entdel ename)
    (setq nearpnt (osnap snappnt "nea"))
    (if nearpnt
      (progn
        (setq ang (angle nearpnt snappnt))
        (cond
          ((and
             (>= ang (/ pi 6.0))
             (<= ang pi)
           )
            (setq ang (- ang (/ pi 2.0)))
            (entdel era)
            (setq ename era)
            (setq dra (subst
                        (cons 10 nearpnt)
                        (assoc 10 dra)
                        dra
                      )
            )
            (setq nearpnt nil)
            (setq dra (subst
                        (cons 50 ang)
                        (assoc 50 dra)
                        dra
                      )
            )
            (entmod dra)
          )
          ((or
             (= ang 0.0)
             (and
               (> ang (* (/ pi 6.0) 7.0))
               (< ang (* pi 2.0))
             )
           )
            (setq ang (+ ang (/ pi 2.0)))
            (entdel erb)
            (setq ename erb)
            (setq drb (subst
                        (cons 10 nearpnt)
                        (assoc 10 drb)
                        drb
                      )
            )
            (setq nearpnt nil)
            (setq drb (subst
                        (cons 50 ang)
                        (assoc 50 drb)
                        drb
                      )
            )
            (entmod drb)
          )
          (t
            (entdel era)
            (setq ename era)
            (setq nearpnt nil)
          )
        )
      )
      (progn
        (entdel era)
        (setq ename era)
        (setq dra (subst
                    (cons 10 snappnt)
                    (assoc 10 dra)
                    dra
                  )
        )
        (setq dra (subst
                    (cons 50 0.0)
                    (assoc 50 dra)
                    dra
                  )
        )
        (entmod dra)
        (setq nearpnt nil)
      )
    )
  )
  (setvar "cmdecho" 0)
  (vl-load-com)
  (setq os (getvar "osmode"))
  (setq olderr *error*)
  (setq *error* myerr)
  (setvar "osmode" 0)
  (command "undo" "be")
  (setq scl (getvar "dimscale"))
  (setq value "3.2")
  (setq prcs 1)
  (setq dclname (vl-filename-mktemp "rough.dcl")
        f (open dclname "w")
  )
  (write-line "roughness:dialog{ label=\"风之影粗糙度\"; spacer; " f)
  (write-line " :row { :column {  " f)
  (write-line ":image_button { key = \"RM\"; aspect_ratio = 1; width = 8; fixed_width = true; color = graphics_background; allow_accept = true; }"
              f
  )
  (write-line ":image_button { key = \"UN\"; aspect_ratio = 1; width = 8; fixed_width = true; color = graphics_background; allow_accept = true; } "
              f
  )
  (write-line ":image_button { key = \"BS\"; aspect_ratio = 1; width = 8; fixed_width = true; color = graphics_background; allow_accept = true; } } "
              f
  )
  (write-line ":list_box { key=\"RV\"; value=8; width=16; height=14; allow_accept=true; } } " f)
  (write-line ":errtile { width=18; } ok_cancel;}" f)
  (close f)
  (setq dcl_re (load_dialog dclname))
  (new_dialog "roughness" dcl_re "" dcl_pt)
  (setq llist '("" "0.025"
         "0.05" "0.1"
         "0.2" "0.4"
         "0.8" "1.6"
         "3.2" "6.3"
         "12.5" "25"
         "50"
        )
  )
  (start_list "RV")
  (mapcar
    'add_list
    llist
  )
  (end_list)
  (image 0 0 0)
  (set_tile "RV" "8")
  (set_tile "error" (strcat "粗糙度为 Ra3.2"))
  (action_tile "RM" "(image 1 0 0) (setq prcs 1)")
  (action_tile "UN" "(image 0 1 0)  (setq prcs 2)")
  (action_tile "BS" "(image 0 0 1)  (setq prcs 0)")
  (action_tile "RV" "(do_list)")
  (action_tile "accept" "(done_dialog 1)(setq do T)")
  (action_tile "cancel" "(done_dialog 0)")
  (start_dialog)
  (unload_dialog dcl_re)
  (vl-file-delete dclname)
  (if do
    (progn
      (setq p00 '(0.0 0.0 0.0))
      (setq p1u '(2.3094 4.0 0.0))
      (setq p2u '(-2.3094 4.0 0.0))
      (setq p3u '(5.7735 10.0 0.0))
      (setq pcu '(0.0 2.67 0.0))
      (setq ptu '(0.0 6.5 0.0))
      (setq p1d '(-2.3094 -4.0 0.0))
      (setq p2d '(2.3094 -4.0 0.0))
      (setq p3d '(-5.7735 -10.0 0.0))
      (setq pcd '(0.0 -2.67 0.0))
      (setq ptd '(0.0 -6.5 0.0))
      (setq pqy '(-9.0 3.0 0.0))
      (create_ra)
      (create_rb)
      (entdel erb)
      (prompt "\n选择插入点，[A键]增加，[S键]减小：")
      (setq ename era)
      (setq loop t)
      (while loop
        (setq code (grread t 15 0))
        (cond
          ((= (car code) 5)
            (do_move)
          )
          ((= (car code) 3)
            (do_left)
          )
          ((or
             (= (car code) 11)
             (= (car code) 25)
           )
            (do_right)
          )
          ((or
             (equal code '(2 97))
             (equal code' (2 65))
           )
            (do_a)
          )
          ((or
             (equal code '(2 115))
             (equal code' (2 83))
           )
            (do_s)
          )
        )
      )
    )
  )
  (setvar "osmode" os)
  (command "undo" "e")
  (setq *error* olderr)
  (princ)
)

ninja37

楼主的工具 总是那么实用  都是精品

白色微風1991

支持，收藏，學習。

zhangyan_0320

支持支持，太好用了

xzd716

非常好用！谢谢分享