如何预览图案？
如何预览图案？高亮显示选择行并在修改行后刷新。
图案修改。rar公司
(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 (openfiles "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 (openpatfile "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 ;
}
}
}
}
}
就像这样
我很欣赏语言差异，但“帮助”中有关于Pat文件详细信息含义的详细信息。我会尽量找到我有旧的纸质副本，以便更快地找到像这样的东西，但在工作中。
https://knowledge.autodesk.com/support/autocad/troubleshooting/caas/sfdcarticles/sfdcarticles/Creating-new-Custom-Hatch-patterns.html
在添加acad之前，我建议使用lisp通过尝试绘制pat文件来检查pat文件。pat已经有一段时间了，很确定可以加载自定义。pat等 @贝尔克斯：
DCL有限。没有专门用于此目的的瓷砖。但您可以使用vector_image函数在DCL图像块中绘制向量。因此，应该可以显示填充图案。不过，这需要一些工作。
也许值得一看OpenDCL，它确实有一个图案填充控件。 哈哈，找一个图案制作工具，我想要的是它的外观。
所以：使用OpenDCL。
页:
[1]