不知道VB.net怎么做!
终于找到了。。虽然目前以我的水平看不懂源码，但程序非常好用。谢谢楼主分享！！！
下载了就过来 顶贴人性化程序，不错赞个~
没错，这就是我一直在找的源码
收藏之，谢谢楼主
收藏之，谢谢楼主
本帖最后由 langjs 于 2022-5-27 11:18 编辑
这个程序真好用，加入我的工具箱了。修改了一下，把幻灯片和对话框整合到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选择插入点，增加，减小：")
(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)
)
楼主的工具 总是那么实用都是精品
支持，收藏，學習。
支持支持，太好用了
非常好用！谢谢分享