竖线改变

lucas3 · 发表于 2014-8-22 18:08:19

csharp 发表于 2014-8-22 17:45
选择专家模式，直接编译就可以使用，将 slb 和 vlx 放到 Support 目录

谢谢回贴，这个编译是没有问题，我的真正目的还是希望学习把对话框写入到lisp当中！

Free-Lancer · 发表于 2014-8-23 10:07:32

lucas3 发表于 2014-8-22 18:08
谢谢回贴，这个编译是没有问题，我的真正目的还是希望学习把对话框写入到lisp当中！

将 DCL 转为字串列表

;;将DCL表写出文件
(defun dcl:make (lst / flname ofile)
(setq FlName (vl-filename-mktemp (strcat "FYDCL" ".dcl"))
oFile (open FlName "w")
)
(foreach fStream lst (write-line fStream oFile)) ;写入文件
(close oFile) ;_关闭文档
flname
)
;;by cabinsummer
(defun c:rough (/ scl value prcs DLG_ID llist p1u p2u
p3u pcu ptu pqy p1d p2d p3d pcd
ptd ename era erb dra drb snappnt
nearpnt tag code ang max_x max_y do
p00 ra rb tmpfl strl
)
(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)
)
;;
(setvar "cmdecho" 0)
(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 strl '("roughness:dialog{ "
"label=\"粗糙度\"; "
"spacer; "
":row{ "
" :column{ "
" :image_button{ key = \"RM\";"
" aspect_ratio = 1; "
" width = 8; "
" fixed_width = true; "
" color = -2; "
" allow_accept = true; "
" } "
" :image_button{ "
" key = \"UN\"; "
" aspect_ratio = 1; "
" width = 8; "
" fixed_width = true; "
" color = -2; "
" allow_accept = true; "
" } "
" :image_button{ key = \"BS\";"
" aspect_ratio = 1; "
" width = 8; "
" fixed_width = true; "
" color = -2; "
" allow_accept = true; "
" } "
" } "
" :list_box{ "
" key=\"RV\"; "
" value=8; "
" width=16; "
" height=14; "
" allow_accept=true; "
" } "
" } "
" :row{ "
" :errtile{ "
" width= 14; "
" } "
" :edit_box{ "
" label = \"比例:\"; "
" key = \"SC\"; "
" edit_width = 3; "
" } "
" } "
" ok_cancel; "
"} "
)
) ;_DCL
(setq tmpfl (dcl:make strl)) ;_写出临时DCL
(setq DLG_ID (load_dialog tmpfl))
(new_dialog "roughness" DLG_ID)
;;
(start_image "RM")
(setq max_x (dimx_tile "RM")
max_y (dimy_tile "RM")
)
(slide_image
5
5
(- max_x 10)
(- max_y 10)
(strcat (findfile "rough.slb") "(RM)")
)
(end_image)
(start_image "UN")
(setq max_x (dimx_tile "UN")
max_y (dimy_tile "UN")
)
(slide_image
5
5
(- max_x 10)
(- max_y 10)
(strcat (findfile "rough.slb") "(UN)")
)
(end_image)
(start_image "BS")
(setq max_x (dimx_tile "BS")
max_y (dimy_tile "BS")
)
(slide_image
5
5
(- max_x 10)
(- max_y 10)
(strcat (findfile "rough.slb") "(BS)")
)
(end_image)
(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)
(set_tile "RV" "8")
(set_tile "error" (strcat "粗糙度为 Ra3.2"))
(action_tile "RM" "(setq prcs 1)")
(action_tile "UN" "(setq prcs 2)")
(action_tile "BS" "(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 DLG_ID)
(vl-file-delete tmpfl) ;_删除临时DCL
(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 '(-12.0 3.0 0.0))
(create_ra)
(create_rb)
(entdel erb)
(prompt "选择插入点")
(setq ename era)
(setq loop T)
(while loop
(setq code (grread T 8))
(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)
)
(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)
'(8 . "DIM")
'(40 . 2.5)
'(62 . 3)
'(72 . 4)
(cons 1 value)
)
)
(cond
((= prcs 1)
(entmake (list '(0 . "LINE")
(cons 10 p1u)
(cons 11 p2u)
'(8 . "DIM")
)
)
)
((= prcs 2)
(entmake (list '(0 . "CIRCLE")
(cons 10 pcu)
'(40 . 1.33)
'(8 . "DIM")
)
)
)
)
(entmake (list '(0 . "LINE")
(cons 10 p00)
(cons 11 p2u)
'(8 . "DIM")
)
)
(entmake (list '(0 . "LINE")
(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)
'(8 . "DIM")
'(40 . 2.5)
'(62 . 3)
'(72 . 4)
(cons 1 value)
)
)
(cond
((= prcs 1)
(entmake (list '(0 . "LINE")
(cons 10 p1d)
(cons 11 p2d)
'(8 . "DIM")
)
)
)
((= prcs 2)
(entmake (list '(0 . "CIRCLE")
(cons 10 pcd)
'(40 . 1.33)
'(8 . "DIM")
)
)
)
)
(entmake (list '(0 . "LINE")
(cons 10 p00)
(cons 11 p2d)
'(8 . "DIM")
)
)
(entmake (list '(0 . "LINE")
(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")
'(8 . "DIM")
'(10 0.0 0.0 0.0)
(cons 40 (* scl 5.0))
'(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)
)
)
)

;;将DCL表写出文件 
(defun dcl:make        (lst / flname ofile) 
  (setq        FlName (vl-filename-mktemp (strcat "FYDCL" ".dcl")) 
        oFile  (open FlName "w") 
  ) 
  (foreach fStream lst (write-line fStream oFile)) ;写入文件 
  (close oFile) ;_关闭文档 
  flname 
) 
;;by cabinsummer 
 
(defun c:rough (/      scl    value  prcs   DLG_ID llist  p1u         p2u 
                p3u    pcu    ptu    pqy    p1d           p2d          p3d         pcd 
                ptd    ename  era    erb    dra           drb          snappnt 
                nearpnt              tag    code   ang           max_x  max_y         do 
                p00    ra     rb     tmpfl strl 
               ) 
  (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) 
  ) 
  ;; 
  (setvar "cmdecho" 0) 
  (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        strl '("roughness:dialog{                  " 
               "label=\"粗糙度\";                  " 
               "spacer;                          " 
               ":row{                                  " 
               "  :column{                          " 
               "     :image_button{ key = \"RM\";" 
               "      aspect_ratio = 1;          " 
               "      width = 8;                  " 
               "      fixed_width = true;          " 
               "      color = -2;                  " 
               "      allow_accept = true;          " 
               "      }                          " 
               "     :image_button{                  " 
               "      key = \"UN\";                  " 
               "      aspect_ratio = 1;          " 
               "      width = 8;                  " 
               "      fixed_width = true;          " 
               "      color = -2;                  " 
               "      allow_accept = true;          " 
               "      }                          " 
               "     :image_button{ key = \"BS\";" 
               "      aspect_ratio = 1;          " 
               "      width = 8;                  " 
               "      fixed_width = true;          " 
               "      color = -2;                  " 
               "      allow_accept = true;          " 
               "     }                                  " 
               "   }                                  " 
               "   :list_box{                          " 
               "    key=\"RV\";                  " 
               "    value=8;                          " 
               "    width=16;                          " 
               "    height=14;                          " 
               "    allow_accept=true;                  " 
               "    }                                  " 
               "  }                                  " 
               "  :row{                          " 
               "    :errtile{                          " 
               "     width= 14;                  " 
               "     }                                  " 
               "    :edit_box{                          " 
               "     label = \"比例:\";          " 
               "     key = \"SC\";                  " 
               "     edit_width = 3;                  " 
               "     }                                     " 
               "   }                                  " 
               "    ok_cancel;                           " 
               "}                                  " 
              ) 
  ) ;_DCL 
  (setq tmpfl (dcl:make strl)) ;_写出临时DCL 
 
  (setq DLG_ID (load_dialog tmpfl)) 
  (new_dialog "roughness" DLG_ID) 
  ;; 
  (start_image "RM") 
  (setq        max_x (dimx_tile "RM") 
        max_y (dimy_tile "RM") 
  ) 
  (slide_image 
    5 
    5 
    (- max_x 10) 
    (- max_y 10) 
    (strcat (findfile "rough.slb") "(RM)") 
  ) 
 
  (end_image) 
  (start_image "UN") 
  (setq        max_x (dimx_tile "UN") 
        max_y (dimy_tile "UN") 
  ) 
  (slide_image 
    5 
    5 
    (- max_x 10) 
    (- max_y 10) 
    (strcat (findfile "rough.slb") "(UN)") 
  ) 
  (end_image) 
  (start_image "BS") 
  (setq        max_x (dimx_tile "BS") 
        max_y (dimy_tile "BS") 
  ) 
  (slide_image 
    5 
    5 
    (- max_x 10) 
    (- max_y 10) 
    (strcat (findfile "rough.slb") "(BS)") 
  ) 
  (end_image) 
  (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) 
  (set_tile "RV" "8") 
  (set_tile "error" (strcat "粗糙度为 Ra3.2")) 
  (action_tile "RM" "(setq prcs 1)") 
  (action_tile "UN" "(setq prcs 2)") 
  (action_tile "BS" "(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 DLG_ID) 
  (vl-file-delete tmpfl) ;_删除临时DCL 
 
  (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 '(-12.0 3.0 0.0)) 
      (create_ra) 
      (create_rb) 
      (entdel erb) 
      (prompt "选择插入点") 
      (setq ename era) 
      (setq loop T) 
      (while loop 
        (setq code (grread T 8)) 
        (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) 
) 
 
(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) 
                 '(8 . "DIM") 
                 '(40 . 2.5) 
                 '(62 . 3) 
                 '(72 . 4) 
                 (cons 1 value) 
           ) 
  ) 
  (cond 
    ((= prcs 1) 
     (entmake (list '(0 . "LINE") 
                    (cons 10 p1u) 
                    (cons 11 p2u) 
                    '(8 . "DIM") 
              ) 
     ) 
    ) 
    ((= prcs 2) 
     (entmake (list '(0 . "CIRCLE") 
                    (cons 10 pcu) 
                    '(40 . 1.33) 
                    '(8 . "DIM") 
              ) 
     ) 
    ) 
  ) 
  (entmake (list '(0 . "LINE") 
                 (cons 10 p00) 
                 (cons 11 p2u) 
                 '(8 . "DIM") 
           ) 
  ) 
  (entmake (list '(0 . "LINE") 
                 (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) 
                 '(8 . "DIM") 
                 '(40 . 2.5) 
                 '(62 . 3) 
                 '(72 . 4) 
                 (cons 1 value) 
           ) 
  ) 
  (cond 
    ((= prcs 1) 
     (entmake (list '(0 . "LINE") 
                    (cons 10 p1d) 
                    (cons 11 p2d) 
                    '(8 . "DIM") 
              ) 
     ) 
    ) 
    ((= prcs 2) 
     (entmake (list '(0 . "CIRCLE") 
                    (cons 10 pcd) 
                    '(40 . 1.33) 
                    '(8 . "DIM") 
              ) 
     ) 
    ) 
  ) 
  (entmake (list '(0 . "LINE") 
                 (cons 10 p00) 
                 (cons 11 p2d) 
                 '(8 . "DIM") 
           ) 
  ) 
  (entmake (list '(0 . "LINE") 
                 (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") 
          '(8 . "DIM") 
          '(10 0.0 0.0 0.0) 
          (cons 40 (* scl 5.0)) 
          '(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) 
    ) 
  ) 
)

lucas3 · 发表于 2014-8-23 12:06:04

Free-Lancer 发表于 2014-8-23 10:07
将 DCL 转为字串列表

谢谢Free-Lancer大师，用文件比较查看了下，有三到四处修改过，慢慢研究，举一反三，哈哈。

Free-Lancer · 发表于 2014-8-23 16:06:13

lucas3 发表于 2014-8-23 12:06
谢谢Free-Lancer大师，用文件比较查看了下，有三到四处修改过，慢慢研究，举一反三，哈哈。

再复习下DCL

(defun c:rough (/ scl value prcs DLG_ID llist p1u p2u
p3u pcu ptu pqy p1d p2d p3d pcd
ptd ename era erb dra drb snappnt
nearpnt tag code ang max_x max_y do
p00 ra rb tmpfl slbname
)
(fy:begin)
(fy:setv "osmode" 0)
(setq scl (getvar "dimscale")
slbname (findfile "rough.slb")
value "3.2"
prcs 0
llist '("" "0.025" "0.05" "0.1" "0.2" "0.4"
"0.8" "1.6" "3.2" "6.3" "12.5" "25"
"50"
)
strl '("roughness:dialog{ "
"label=\"粗糙度\"; "
"spacer; "
":row{ "
" :column{ "
" :image_button{ key = \"RM\";"
" aspect_ratio = 1; "
" width = 8; "
" fixed_width = true; "
" color = -2; "
" allow_accept = true; "
" } "
" :image_button{ "
" key = \"UN\"; "
" aspect_ratio = 1; "
" width = 8; "
" fixed_width = true; "
" color = -2; "
" allow_accept = true; "
" } "
" :image_button{ key = \"BS\";"
" aspect_ratio = 1; "
" width = 8; "
" fixed_width = true; "
" color = -2; "
" allow_accept = true; "
" } "
" } "
" :list_box{ "
" key=\"RV\"; "
" value=8; "
" width=16; "
" height=14; "
" allow_accept=true; "
" } "
" } "
" :row{ "
" :errtile{ "
" width= 14; "
" } "
" :edit_box{ "
" label = \"比例:\"; "
" key = \"SC\"; "
" edit_width = 3; "
" } "
" } "
" ok_cancel; "
"} "
)
) ;_DCL
(setq tmpfl (dcl:make strl) ;_写出临时DCL
DLG_ID (dcl:load tmpfl "roughness")
)
;;Dialog Initialize
(mapcar '(lambda (key fn)
(Dcl:SlideImage key fn 0)
)
'("RM" "UN" "BS")
(list (strcat slbname "(RM)")
(strcat slbname "(UN)")
(strcat slbname "(BS)")
)
)
(Dcl:AddList "RV" llist 8)
(dcl:seterror (strcat "粗糙度为 Ra3.2"))
;;Dialog Actions
(mapcar '(lambda (x)
(action_tile x "(setq prcs $key)")
)
'("RM" "UN" "BS")
)
;;(action_tile "RV" "(do_list)")
(action_tile
"RV"
"(dcl:seterror (strcat \"粗糙度为 Ra\" (nth (atoi (get_tile \"RV\")) llist)))"
)
(action_tile "accept" "(done_dialog 1)(setq do T)")
(action_tile "cancel" "(done_dialog 0)")
;;Strat Dialog
(start_dialog)
(unload_dialog DLG_ID)
(vl-file-delete tmpfl) ;_删除临时DCL
(if do
(progn
(setq p00 '(0.0 0.0 0.0)
p1u '(2.3094 4.0 0.0)
p2u '(-2.3094 4.0 0.0)
p3u '(5.7735 10.0 0.0)
pcu '(0.0 2.67 0.0)
ptu '(0.0 6.5 0.0)
p1d '(-2.3094 -4.0 0.0)
p2d '(2.3094 -4.0 0.0)
p3d '(-5.7735 -10.0 0.0)
pcd '(0.0 -2.67 0.0)
ptd '(0.0 -6.5 0.0)
pqy '(-12.0 3.0 0.0)
)
(create_ra)
(create_rb)
(entdel erb)
(prompt "选择插入点")
(setq ename era
loop T
)
(while loop
(setq code (grread T 8))
(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))
)
)
)
)
(fy:end)
(princ)
)

(defun c:rough (/      scl    value  prcs   DLG_ID llist  p1u         p2u 
                p3u    pcu    ptu    pqy    p1d           p2d          p3d         pcd 
                ptd    ename  era    erb    dra           drb          snappnt 
                nearpnt              tag    code   ang           max_x  max_y         do 
                p00    ra     rb     tmpfl  slbname 
               ) 
  (fy:begin) 
  (fy:setv "osmode" 0) 
  (setq        scl        (getvar "dimscale") 
        slbname        (findfile "rough.slb") 
        value        "3.2" 
        prcs        0 
        llist        '(""           "0.025"  "0.05"   "0.1"    "0.2"    "0.4" 
                  "0.8"           "1.6"    "3.2"    "6.3"    "12.5"   "25" 
                  "50" 
                 ) 
        strl        '("roughness:dialog{                  " 
                  "label=\"粗糙度\";                  " 
                  "spacer;                          " 
                  ":row{                          " 
                  "  :column{                          " 
                  "     :image_button{ key = \"RM\";" 
                  "      aspect_ratio = 1;          " 
                  "      width = 8;                  " 
                  "      fixed_width = true;          " 
                  "      color = -2;                  " 
                  "      allow_accept = true;          " 
                  "      }                          " 
                  "     :image_button{                  " 
                  "      key = \"UN\";                  " 
                  "      aspect_ratio = 1;          " 
                  "      width = 8;                  " 
                  "      fixed_width = true;          " 
                  "      color = -2;                  " 
                  "      allow_accept = true;          " 
                  "      }                          " 
                  "     :image_button{ key = \"BS\";" 
                  "      aspect_ratio = 1;          " 
                  "      width = 8;                  " 
                  "      fixed_width = true;          " 
                  "      color = -2;                  " 
                  "      allow_accept = true;          " 
                  "     }                          " 
                  "   }                                  " 
                  "   :list_box{                  " 
                  "    key=\"RV\";                  " 
                  "    value=8;                          " 
                  "    width=16;                  " 
                  "    height=14;                  " 
                  "    allow_accept=true;          " 
                  "    }                          " 
                  "  }                                  " 
                  "  :row{                          " 
                  "    :errtile{                  " 
                  "     width= 14;                  " 
                  "     }                          " 
                  "    :edit_box{                  " 
                  "     label = \"比例:\";          " 
                  "     key = \"SC\";                  " 
                  "     edit_width = 3;                  " 
                  "     }                             " 
                  "   }                                  " 
                  "    ok_cancel;                  " 
                  "}                                  " 
                 ) 
  ) ;_DCL 
  (setq        tmpfl  (dcl:make strl) ;_写出临时DCL 
        DLG_ID (dcl:load tmpfl "roughness") 
  ) 
  ;;Dialog Initialize 
  (mapcar '(lambda (key fn) 
             (Dcl:SlideImage key fn 0) 
           ) 
          '("RM" "UN" "BS") 
          (list        (strcat slbname "(RM)") 
                (strcat slbname "(UN)") 
                (strcat slbname "(BS)") 
          ) 
  ) 
  (Dcl:AddList "RV" llist 8) 
  (dcl:seterror (strcat "粗糙度为 Ra3.2")) 
  ;;Dialog Actions 
  (mapcar '(lambda (x) 
             (action_tile x "(setq prcs $key)") 
           ) 
          '("RM" "UN" "BS") 
  ) 
  ;;(action_tile "RV" "(do_list)") 
  (action_tile 
    "RV" 
    "(dcl:seterror (strcat \"粗糙度为 Ra\" (nth (atoi (get_tile \"RV\")) llist)))" 
  ) 
  (action_tile "accept" "(done_dialog 1)(setq do T)") 
  (action_tile "cancel" "(done_dialog 0)") 
  ;;Strat Dialog 
  (start_dialog) 
  (unload_dialog DLG_ID) 
  (vl-file-delete tmpfl) ;_删除临时DCL 
  (if do 
    (progn 
      (setq p00        '(0.0 0.0 0.0) 
            p1u        '(2.3094 4.0 0.0) 
            p2u        '(-2.3094 4.0 0.0) 
            p3u        '(5.7735 10.0 0.0) 
            pcu        '(0.0 2.67 0.0) 
            ptu        '(0.0 6.5 0.0) 
            p1d        '(-2.3094 -4.0 0.0) 
            p2d        '(2.3094 -4.0 0.0) 
            p3d        '(-5.7735 -10.0 0.0) 
            pcd        '(0.0 -2.67 0.0) 
            ptd        '(0.0 -6.5 0.0) 
            pqy        '(-12.0 3.0 0.0) 
      ) 
      (create_ra) 
      (create_rb) 
      (entdel erb) 
      (prompt "选择插入点") 
      (setq ename era 
            loop T 
      ) 
      (while loop 
        (setq code (grread T 8)) 
        (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)) 
        ) 
      ) 
    ) 
  ) 
  (fy:end) 
  (princ) 
)

lucas3 · 发表于 2014-11-7 18:32:51

本帖最后由 lucas3 于 2014-11-10 11:31 编辑

Free-Lancer 发表于 2014-8-23 10:07
将 DCL 转为字串列表

Free-Lancer大师您好! 我按照您的方法改了一个,可是不成功了,{:soso_e109:} 不知道哪里的问题,原来是三个文件,一个lisp, 一个dcl, 和一个ini文件 ,现在将lisp与DCL整合了,可是不成功,您帮我看看,谢谢!

另外,能不能在lisp中写一点,就是不要那个单独的ini文件, 写到程序中,如果没有ini则建立一个ini , ini里的内容还是跟这个压缩文件里的一样.

st788796 · 发表于 2014-11-8 12:20:23

xdapi将提供一个方便的函数，指定一个曲线做界限，围合一个范围点集，围合内的曲线端点自动延伸到界限曲线或被修剪

lucas3 · 发表于 2014-11-10 11:01:45

Free-Lancer 发表于 2014-8-23 16:06
再复习下DCL

Free-Lancer大师,我将

(if (> (setq DLG_ID (load_dialog (findfile "tcfdc.dcl"))) 0)

改成

(if (> (setq DLG_ID (load_dialog "tcfdc.dcl")) 0)

之后,运行命令tcf后,什么也没有反应了,也不报错

(if (> (setq DLG_ID (load_dialog "tcfdc.dcl")) 0)
(while (and (/= result 1) (/= result 0))
(if (= do_what 3)
(tolib)
)
(if (new_dialog "teclib" DLG_ID)
(progn
(updlst "itemlist" crtlst)
(set_tile "itemlist" "0")
(set_tile "item" textstr)
(mode_tile "item" 2)
(mode_tile "up" 1)
(mode_tile "up0" 1)
(mode_tile "down0" 1)
(if (null crtlst0)(mode_tile "removelist" 1))
(action_tile "itemlist" "(do_list \"itemlist\")")
(action_tile "item" "(setq textstr $value)")
(action_tile "mdf" "(mdfitem)")
(action_tile "add" "(additem)")
(action_tile "del" "(delitem)")
(action_tile "up" "(upitem)")
(action_tile "down" "(downitem)")
(action_tile "itemlist0" "(do_list \"itemlist0\")")
(action_tile "addlist" "(addlist)")
(action_tile "removelist" "(removelist)")
(action_tile "up0" "(upitem0)")
(action_tile "down0" "(downitem0)")
(action_tile "pick" "(setq do_what 3)(done_dialog)")
(action_tile "accept" "(setq result 1)(done_dialog)")
(action_tile "cancel" "(setq result 0)(done_dialog 0)")
(start_dialog)
)
)
)
)

(if (> (setq DLG_ID (load_dialog "tcfdc.dcl")) 0) 
    (while (and (/= result 1) (/= result 0)) 
      (if (= do_what 3) 
        (tolib) 
      ) 
      (if (new_dialog "teclib" DLG_ID) 
        (progn 
          (updlst "itemlist" crtlst) 
          (set_tile "itemlist" "0") 
          (set_tile "item" textstr) 
          (mode_tile "item" 2) 
          (mode_tile "up" 1) 
          (mode_tile "up0" 1) 
          (mode_tile "down0" 1) 
          (if (null crtlst0)(mode_tile "removelist" 1)) 
          (action_tile "itemlist" "(do_list \"itemlist\")") 
          (action_tile "item" "(setq textstr $value)") 
          (action_tile "mdf" "(mdfitem)") 
          (action_tile "add" "(additem)") 
          (action_tile "del" "(delitem)") 
          (action_tile "up" "(upitem)") 
          (action_tile "down" "(downitem)") 
          (action_tile "itemlist0" "(do_list \"itemlist0\")") 
          (action_tile "addlist" "(addlist)") 
          (action_tile "removelist" "(removelist)") 
          (action_tile "up0" "(upitem0)") 
          (action_tile "down0" "(downitem0)") 
          (action_tile "pick" "(setq do_what 3)(done_dialog)") 
          (action_tile "accept" "(setq result 1)(done_dialog)") 
          (action_tile "cancel" "(setq result 0)(done_dialog 0)") 
          (start_dialog) 
        ) 
      ) 
    ) 
  )

Free-Lancer · 发表于 2014-11-10 11:15:44

lucas3 发表于 2014-11-10 11:01
Free-Lancer大师,我将

改成

发完整的上来，Lisp + dcl

lucas3 · 发表于 2014-11-10 11:37:35

本帖最后由 lucas3 于 2014-11-10 15:34 编辑

Free-Lancer 发表于 2014-11-10 11:15
发完整的上来，Lisp + dcl

谢谢大师LISP与DCL在压缩文件中 , 可以正常运行!我将LISP与DCL整合后,不能运行了

iLisp · 发表于 2014-11-10 12:26:59

lucas3 发表于 2014-11-10 11:37
谢谢大师LISP与DCL在压缩文件中 , 可以正常运行

把dcl打包进去，开始还要写出dcl文件，写出时要返回路径，这样程序中load_dialog时用全路径加载dcl文件

lucas3 · 发表于 2014-11-10 12:36:17

iLisp 发表于 2014-11-10 12:26
把dcl打包进去，开始还要写出dcl文件，写出时要返回路径，这样程序中load_dialog时用全路径加载dcl文件

全路径是什么? 绝对路径? 不用吧,没见过用绝过路径的,不是有(setq tcfdc (dcl:make strl)) 这一句吗?

iLisp · 发表于 2014-11-10 12:58:01

lucas3 发表于 2014-11-10 12:36
全路径是什么? 绝对路径? 不用吧,没见过用绝过路径的,不是有(setq tcfdc (dcl:make strl)) 这一句吗?

你里面加载用的是 tcfdc 吗？

lucas3 · 发表于 2014-11-10 13:02:05

iLisp 发表于 2014-11-10 12:58
你里面加载用的是 tcfdc 吗？

是的,详见22#

Free-Lancer · 发表于 2014-11-10 13:48:38

lucas3 发表于 2014-11-10 13:02
是的,详见22#

写出的位置不一定在 support 路径，所以加载不能用 dcl 文件名

(setq DLG_ID (load_dialog "tcfdc.dcl"))
=〉
(setq DLG_ID (load_dialog tcfdc))

xvjiex · 发表于 2021-7-20 00:04:56

感谢楼主分享竖线改变

账号		自动登录	找回密码
密码			立即注册

[每日一码] 竖线改变

点评

点评

评分

点评

点评

点评

点评

点评

点评

点评

点评

点评

评分