[编程交流] 如何预览图案？

(defun c:pm()
;-------------------------
(defun parsestr->lst (str / LST POS str)
        (while (setq pos (vl-string-search "," str))
                (setq lst (cons (vl-string-left-trim " "(substr str 1 pos)) lst)
                        str (substr str (+ pos 2))
                        )
        )
        (if (> (strlen str) 0)
                (setq lst (cons (vl-string-left-trim " " str) lst))
        )
        (reverse lst)
)
;-------------------------
;(joinlst->str (list "1" "2" "3" "4" "5" "6"))
(defun joinlst->str (lst / LST POS str)
        (setq str "")
        (while lst
                (setq x (car lst))
                (if (setq lst(cdr lst))
                        (setq str (strcat str x ","))
                        (setq str (strcat str x))
                )
        )
        str
)
;-------------------------
(defun subst-index(var n lst / i)
        (setq i -1)
        (mapcar '(lambda(x) (if (= n (setq i (1+ i))) var x)) lst)
)
;-----------DELETE A ITOM--------------
;(delete-index 1 '((1 2 3) (4 5 6)(7 8 9)))
(defun delete-index(n lst / i)
        (setq i -1)
        (vl-remove-if '(lambda(x) (= (setq i (1+ i)) n)) lst)
)
;-----------INSERT A ITOM--------------
;(add-index "A" -1 '(0 1 2 3 4 5))
(defun add-index(var n lst / len i newlst)
        (setq len (length lst))
        (cond
                ((< n 0)
                        (setq newlst (cons var lst))
                )
                ((>= n len)
                        (setq newlst (reverse(cons var (reverse lst))))
                )
                (t
                        (setq i -1 newlst nil)
                        (foreach itom lst
                                (if (= n (setq i (1+ i)))
                                        (setq newlst (cons itom newlst)
                                                newlst (cons var newlst)
                                        )
                                        (setq newlst (cons itom newlst))
                                )
                        )
                        (setq newlst (reverse newlst))
                )
        )
        newlst
)
;-------------------------
(defun LM:editbox ( str / han )
        (and (< 0 (setq han (load_dialog "acad")))
                (new_dialog  "acad_txtedit" han)
                (set_tile    "text_edit"    str)
                (action_tile "text_edit" "(setq str $value)")
                (if (zerop (start_dialog)) (setq str nil))
        )
        (if (< 0 han) (unload_dialog han))
        str
)
;-------------------------
(defun readpatfile(file / files fn PatternList pat x fn)
        (if (and (setq files(findfile file))
                        (setq fn (open  files "r"))
                )
                (progn
                        (setq PatternList NIL pat nil)
                        (while (setq x (read-line fn))
                                (cond
                                        ((wcmatch X "`**")
                                                (if pat
                                                        (setq PatternList (cons (reverse pat) PatternList))
                                                )
                                                (setq pat nil
                                                        pat (cons x pat)
                                                )
                                        )
                                        ((wcmatch X "#*#*#*#*")
                                                (setq pat(cons x pat))
                                        )
                                        (t nil)
                                )
                        )
                        (setq PatternList (cons (reverse pat) PatternList))
                        (close fn)
                )
        )
        (reverse PatternList)
)
;-------------------------
(defun show_list(key newlist)
        (start_list key)
        (mapcar 'add_list newlist)
        (end_list)
)
;-------------------------
(defun act_open()
        (if (setq patfile(getfiled "SELECT A FILE(.PAT) TO OPEN" (get_tile "patfile") "pat" 2))
                (progn
                        (setq PatternList (readpatfile patfile))
                        (show_list "patnamelst" (mapcar 'car PatternList))
                        (show_list "patterninfo" nil)
                )
        )
)
(defun act_save( / fn)
        (if (and (setq patfile(getfiled "SELECT A FILE(.PAT) TO SAVE" (get_tile "patfile") "pat" 2))
                        (setq fn (open  patfile "w"))
                )
                (progn
                        (foreach x PatternList
                                (foreach y x
                                        (write-line y fn)
                                )
                                (write-line ";-----------------" fn)
                        )
                        (close fn)
                )
        )
)
;-----------SSGET TO PATTERN--------------
;------------getpatlinestr-------------
(defun getpatlinestr(/ patlinestr PT0 startpt angpt deltax deltay ang originx originy i ptn0 ptn1 dash)
        (if (and (setq PT0 (getpoint"\n Base point:"))
                        (setq startpt(getpoint"\n Start point:"))
                        (setq angpt(getpoint startpt "\n Angle:"))
                        (or(setq deltax (getdist"\n deltaX<0>:"))(setq deltax 0))
                        (or(setq deltay (getdist"\n deltaY<0>:"))(setq deltay 0))
                )
                (progn
                        (setq ang (angtos(angle startpt angpt)0 4)
                                originx (rtos(- (car startpt) (car pt0)))
                                originy (rtos(- (cadr startpt) (cadr pt0)))
                                patlinestr (strcat ang "," originx "," originy "," (rtos deltax) "," (rtos deltax))
                                )
                        (setq i 1 ptn0 startpt)
                        (while (setq ptn1 (getpoint ptn0 (strcat "\n Get dash" (if (= (rem (setq i (1+ i)) 2)0) "CONTINOUS" "NONE")"distance<EXIT>:")))
                                (setq dash (rtos(distance ptn0 ptn1))
                                        patlinestr (strcat patlinestr "," dash)
                                        ptn0 ptn1
                                        )
                        )
                )
        )
        patlinestr
)
;----------DELETE PATTERN---------------
(defun act_delpattern()
        (if (and (setq patlstn(get_tile "patnamelst"))
                        (setq patlstn (atoi patlstn))
                )
                (progn
                        (setq PatternList (delete-index patlstn PatternList))
                        (show_list "patnamelst" (mapcar 'car PatternList))
                        (set_tile "patnamelst" (itoa patlstn))
                )
        )
)
;----------search pattern---------------
(defun act_searchpattern(/ searchstr)
        (if (/= (setq searchstr(get_tile "searchstr"))"")
                (progn
                        (setq tempatlst (vl-remove-if-not '(lambda(x)(wcmatch (car x) (strcat"*" searchstr "*")))PatternList))
                        (show_list "patnamelst" (mapcar 'car tempatlst))
                        (set_tile "patnamelst" "0")
                )
        )
)
;----------ADD ONE LINE---------------
(defun act_addline()
        (if (setq patterninfon (get_tile "patterninfo"))
                (setq patterninfon (atoi patterninfon))
                (setq patterninfon (length patterninfo))
        )
        (setq patterninfo (add-index "Angle,StartX,StartY,DeltaX,DeltaY" patterninfon patterninfo))
        (show_list "patterninfo" patterninfo)
        (set_tile "patterninfo" (itoa (1+ patterninfon)))
        (act_patvauelst)
)
;----------DELETE ONE LINE---------------
(defun act_deline()
        (if (and (setq patterninfon (get_tile "patterninfo"))
                        (setq patterninfon (atoi patterninfon))
                        )
                (progn
                        (setq patterninfo (delete-index patterninfon patterninfo))
                        (show_list "patterninfo" patterninfo)
                        (set_tile "patterninfo" (itoa patterninfon))
                        (if patterninfo (act_patvauelst))
                )
                (alert "NEED TO SELECT A LINE.")
        )
)
;----------COPY TO recovery---------------
(defun act_copyline()
        (if (and (setq patterninfon (atoi(get_tile "patterninfo")))
                        (setq patlinestr (nth patterninfon patterninfo));该行的字符串
                )
                (progn
                        (setq recoverylst (reverse(cons patlinestr (reverse recoverylst))))
                        (show_list "recoverylst" recoverylst)
                        (set_tile "recoverylst" (itoa (1-(length recoverylst))))
                )
                (alert "NEED TO SELECT A LINE.")
        )
)
;----------recovery A LINE---------------
(defun act_recovery()
        (if (and
                        (setq patterninfon (get_tile "patterninfo"))
                        (setq patterninfon (atoi patterninfon))
                        (setq recoverylstn (atoi(get_tile "recoverylst")))
                        (setq patlinestr (nth recoverylstn recoverylst))
                )
                (progn
                        (setq patterninfo (add-index patlinestr patterninfon patterninfo))
                        (show_list "patterninfo" patterninfo)
                        (set_tile "patterninfo" (itoa patterninfon))
                )
                (alert "Need to select a line in recovery and Selece insert position.")
        )
)
;----------DELETE A LINE IN recovery---------------
(defun act_recoverydel()
        (if (and (setq recoverylstn (get_tile "recoverylst"))
                        (setq recoverylstn (atoi recoverylstn))
                )
                (progn
                        (setq recoverylst (delete-index recoverylstn recoverylst))
                        (show_list "recoverylst" recoverylst)
                        (if recoverylstn (set_tile "recoverylst" (itoa recoverylstn)))
                )
                (alert "NEED TO SELECT A LINE.")
        )
)
;----------CLEAN recovery---------------
(defun act_recoveryclean()
        (setq recoverylst nil)
        (show_list "recoverylst" recoverylst)
)
;-------------------------
(defun act_patnamelst()
        (setq patlstn (atoi(get_tile "patnamelst"))
                patterninfo (nth patlstn PatternList)
                )
        (show_list "patterninfo" patterninfo)
        (set_tile "patterninfo" "0")
        (act_patvauelst)
)
;-------------------------
(defun act_patvauelst( / leard)
        (setq patterninfon (atoi(get_tile "patterninfo"))
                patlinestr (nth patterninfon patterninfo)
                infolst (parsestr->lst patlinestr)
                )
        (if (wcmatch patlinestr "`**")
                (progn
                        (mode_tile "getinfo" 1)
                        (setq leard (list "PatternName" "Description"))
                        )
                (progn
                        (mode_tile "getinfo" 0)
                        (setq leard (list "angle" "originX" "originY" "deltaX" "deltaY" "dash1" "dash2" "dash3" "dash4" "dash5" "dash6" "dash7" "dash8" "dash9")))
        )
        (setq infolst (mapcar '(lambda(x y)(cons x y)) leard infolst))
        (show_list "infolst" (mapcar '(lambda (x) (strcat (car x)"\t= " (cdr x)))infolst))
)
;-------------------------
(defun act_infolst( / var str)
        (if (and (setq var (nth infolstn infolst))
                        (setq str (LM:editbox (cdr var)))
                )
                (progn
                        (setq infolst (subst-index (cons (car var) str) infolstn infolst);
                                patlinestr (joinlst->str (mapcar 'cdr infolst));
                                patterninfo (subst-index patlinestr patterninfon patterninfo);
                                PatternList (subst-index patterninfo patlstn PatternList);
                                )
                        (show_list "patterninfo" patterninfo)
                        (set_tile "patterninfo" (itoa patterninfon))
                        (show_list "infolst" (mapcar '(lambda (x) (strcat (car x)"\t= " (cdr x)))infolst))
                        (set_tile "infolst" (itoa infolstn))
                )
        )
)
;-------------------------
(defun showdcl()
        (if (and(setq dclfile(findfile "PatternModify.dcl"))
                        (>= (setq DCLID (load_dialog dclfile)) 0)
                )
                (progn
                        (new_dialog "pat" DCLID)
                        (set_tile "patfile" patfile)
                        (if PatternList (show_list "patnamelst" (mapcar 'car PatternList)))
                        (if patterninfo(show_list "patterninfo" patterninfo))
                        (if recoverylst(show_list "recoverylst" recoverylst))
                        (if infolst(show_list "infolst" (mapcar '(lambda (x) (strcat (car x)"\t= " (cdr x)))infolst)))
                        ;(if dcldata (setdcldata))
                        (action_tile "open" "(act_open)")
                        (action_tile "save" "(act_save)")
                        (action_tile "delpattern" "(act_delpattern)")
                        (action_tile "searchbut" "(act_searchpattern)")
                        (action_tile "addline" "(act_addline)")
                        (action_tile "deline" "(act_deline)")
                        (action_tile "copyline" "(act_copyline)")
                        (action_tile "recovery" "(act_recovery)")
                        (action_tile "recoverydel" "(act_recoverydel)")
                        (action_tile "recoveryclean" "(act_recoveryclean)")
                        (action_tile "patnamelst" "(act_patnamelst)")
                        (action_tile "patterninfo" "(act_patvauelst)")
                        (action_tile "infolst" "(setq infolstn (atoi $value)) (if(= $reason 4) (act_infolst))")
                        ;(action_tile "open" "(act_openpatfile)")
                        (action_tile "cancel" "(done_dialog)")
                        (action_tile "addpattern" "(done_dialog 11)")
                        (action_tile "getinfo" "(done_dialog 12)")
                        ;(action_tile "accept" "(getdcldata)(done_dialog 0)")
                        (setq return (start_dialog))
                        (cond
                                ((= return 11)
                                        (princ)
                                )
                                ((= return 12)
                                        (if (setq patlinestr (getpatlinestr))
                                                (setq patterninfo (add-index patlinestr patterninfon patterninfo))
                                        )
                                        (showdcl)
                                )
                                (t nil)
                        )
                )
        )
)
;-------------------------
(if (not PatternList)
        (setq patfile (findfile "acadiso.pat")
                PatternList (readpatfile patfile )
        )
)
(showdcl)
)

/*★★★★★ListDCL @ fsxm.mjtd.com★★★★★*/
pat:dialog {
   label = "Pattern Modify" ;
   :row {
       :button {
                                        key = "open" ;
           fixed_width = true ;
           label = "Open" ;
       }
       :button {
           fixed_width = true ;
                                        key = "save" ;
           label = "Save" ;
       }
       :edit_box {
                            key = "patfile" ;
           width = 100 ;
       }
       :button {
           fixed_width = true ;
                                        key = "help" ;
           label = "Help" ;
       }
       :button {
           fixed_width = true ;
           is_cancel = true ;
           label = "Cancel" ;
       }
   }
   :row {
       :boxed_column {
           label = "Pattern List" ;
           children_fixed_height = true ;
           :row {
               fixed_height = true ;
               :button {
                   fixed_width = true ;
                                                                        key = "addpattern" ;
                   label = "Add Pattern" ;
               }
               :button {
                   fixed_width = true ;
                                                                        key = "delpattern" ;
                   label = "Delete Pattern" ;
               }
           }
           :row {
               fixed_height = true ;
               :edit_box {
                   key = "searchstr" ;
               }
               :button {
                   key = "searchbut" ;
                   fixed_width = true ;
                   label = "Search" ;
               }
           }
           :list_box {
               height = 35 ;
               key = "patnamelst" ;
               width = 30 ;
           }
       }
       :boxed_column {
           children_fixed_height = true ;
           label = "Pattern Info" ;
           :row {
               fixed_height = true ;
               :button {
                   fixed_width = true ;
                                                                        key = "addline" ;
                   label = "Add Line" ;
               }
               :button {
                   fixed_width = true ;
                                                                        key = "deline" ;
                   label = "Dele Line" ;
               }
               :button {
                   fixed_width = true ;
                                                                        key = "copyline" ;
                   label = "Copy to Recovery" ;
               }
           }
           :list_box {
               key = "patterninfo" ;
               width = 45 ;
               height = 24 ;
           }
           :image {
               key = "img" ;
                                                        aspect_ratio = 0.6 ;
               color = -2 ;
               width = 45 ;
           }
       }
       :column {
           :boxed_column {
               label = "Recovery" ;
               :row {
                   fixed_height = true ;
                   :button {
                       fixed_width = true ;
                                                                                        key = "recovery" ;
                       label = "Recovery Line" ;
                   }
                   :button {
                       fixed_width = true ;
                                                                                        key = "recoverydel" ;
                       label = "Delete Line" ;
                   }
                   :button {
                       fixed_width = true ;
                                                                                        key = "recoveryclean" ;
                       label = "Clean" ;
                   }
               }
               :list_box {
                   key = "recoverylst" ;
                                                                        fixed_height = true ;
               }
           }
           :boxed_column {
               children_alignment = centered ;
               label = "Modify line info" ;
                                                        :button {
                   fixed_width = true ;
                                                                        key = "getinfo" ;
                   label = "Get Line Info" ;
               }
               :list_box {
                   key = "infolst" ;
                                                                        tabs = "10" ;
                                                                        height = 23 ;
               }
           }
       }
   }
}