精确填充，根据高飞鸟大师代码而来
本帖最后由 尘缘一生 于 2021-7-17 06:19 编辑对于填充，如何精确，不出错，是个头疼的事，本坛高飞鸟大师的几句代码，启发多多，为此，我写了几句，原帖地址：
http://bbs.mjtd.com/forum.php?mo ... %CC%EE%B3%E4&page=1
[*];;读取填充文件patfile（全路径），hname图案定义的第二行---（一级）-----
[*](defun tcxsecon (patfile hname / ret str 1st str1)
[*](setq ret t)
[*](while (and ret (setq str (read-line patfile))) ;读填充文件
[*] (setq 1st (substr str 1 1)) ;每一行的第一个字母
[*] (if (and (= 1st "*") (wcmatch str (strcat "*" hname "*"))) ;如果是图案名字行 ,且是当前填充图案名
[*] (setq str1 (read-line patfile) ret nil) ;读下面一行
[*] )
[*])
[*]str1
[*])
[*];;;取*.pathname 线簇的距离---------（一级）-------------
[*];;hpat *.pat文件名 hname 图案文件名
[*];;例 (dishname "acad.pat" "SWAMP")
[*](defun dishname (hpat hname / patfile measure str1 delta-y)
[*](if (/= (setq patfile (open (strcat sl-path0 "\\填充\\" hpat ".pat") "r")) nil) ;;sl-path0 为三领设计的，安装路径变量
[*] (setq str1 (tcxsecon patfile hname))
[*] (if (/= (setq patfile (open (strcat sl-path0 "\\acadiso.pat") "r")) nil) ;填充的公制与英制
[*] (if (= (setq str1 (tcxsecon patfile hname))nil)
[*] (progn
[*] (setq patfile (open (strcat sl-path0 "\\acad.pat") "r"))
[*] (setq str1 (tcxsecon patfile hname))
[*] )
[*] )
[*] )
[*])
[*](close patfile)
[*](if str1
[*] (progn
[*] (setq delta-y (abs (atof (nth 4 (slparse str1 ","))))) ;第5个值为线簇的距离
[*] (if (or (= delta-y 0) (= delta-y nil))
[*] (setq delta-y (* 20.0 slbl)) ;;如果，那么设置为全局比例的 20倍
[*] )
[*] )
[*] (setq delta-y (* 20.0 slbl))
[*])
[*]delta-y ;;填充图案的 间距设置
[*])
[*];;设置填充比例 tcbl --------(一级)----
[*];;bjname 填充边界实体名 hpat *.pat文件名 hname 图案文件名
[*](defun sltcbl (bjname hpat hname / ptlis dis tcbl)
[*](setq ptlis (ebox4 bjname))
[*](setq dis (* 0.1 (distance (car ptlis) (cadddr ptlis)))) ;;设置边界内10根线
[*](setq tcbl (/ dis (dishname hpat hname)))
[*](setvar "hpscale" tcbl)
[*])
本帖最后由 尘缘一生 于 2021-7-17 02:46 编辑
[*];;字符串转表-----支持汉字---------（一级）------------------
[*];;sstring 字符串 sstr 分割符号
[*](defun slParse (sstring sstr / string_list n1 n2 str_1 m2)
[*](setq string_list '())
[*](setq n1 (strlen sstring))
[*](setq n2 (strlen sstr))
[*](while (setq m2 (vl-string-search sstr sstring))
[*] (setq str_1 (substr sstring 1 m2))
[*] (setq sstring (substr sstring (+ 1 m2 n2)))
[*] (if (/= str_1 "")
[*] (setq string_list (cons str_1 string_list))
[*] )
[*])
[*](if (/= sstring "")
[*] (setq string_list (cons sstring string_list))
[*])
[*](reverse string_list)
[*])
ebox4为实体四点包容，这个函数就不用发了吧，因为，我整合太多，实在无法发出来。
深化下去，可以做到准确填充，期待大家写成更好代码，输入间距，解决，贴瓷砖等准确问题。。。。。。
学习了支持一下
页:
[1]