精确填充，根据高飞鸟大师代码而来

尘缘一生

对于填充，如何精确，不出错，是个头疼的事，本坛高飞鸟大师的几句代码，启发多多，为此，我写了几句，原帖地址：
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
• )
• ;;;取*.pat  hname 线簇的距离---------（一级）-------------
• ;;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)                              
• )
  

尘缘一生

• ;;字符串转表-----支持汉字---------（一级）------------------
• ;;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为实体四点包容，这个函数就不用发了吧，因为，我整合太多，实在无法发出来。
深化下去，可以做到准确填充，期待大家写成更好代码，输入间距，解决，贴瓷砖等准确问题。。。。。。

技术工作室

学习了支持一下