社区 › AutoLISP/Visual LISP 编程技术 › 请教如何用LISP获取CAD中的所有填充图案名

xiaocainiao 发表于 2023-6-7 18:18:37

请教如何用LISP获取CAD中的所有填充图案名

请教各位大神、如何用lisp获取ANSI、ISO和其他预定义中的所有图案名、
自定义填充知道可以搜索关联路径下的pat文件。
预定义的不知道该如何搜索了

edata 发表于 2023-6-9 20:27:42

本帖最后由 edata 于 2023-6-9 20:33 编辑

(defun parsepatfile(fn / fd hp ln)
(if
    (and
      (setq fn (findfile fn))
      (setq fd (open fn "r"))
    )
   (progn
       (while(setq ln (read-line fd))
         (if (wcmatch ln "`**`,*")
         (setq hp
                  (cons
                  (strcase (substr ln 2 (1- (vl-string-position 44 ln))))
                  hp
                  )
         )
         )
       )
       (close fd)
       (reverse hp)
   )
)
)

(parsepatfile (findfile (if (zerop (getvar 'MEASUREMENT)) "acad.pat" "acadiso.pat")))

飞雪神光 发表于 2023-6-7 20:37:30

;;说明:获得图档中包含的填充图案列表
;;返回:填充图案列表
(defun lm-get-hatchlist (/ lst )
        (defun unique ( lst )
                (if lst (cons (car lst) (unique (vl-remove (car lst) (cdr lst)))))
        )
        (defun fixdir ( str )
                (vl-string-right-trim "\\" (vl-string-translate "/" "\\" str))
        )
        (defun parsesupportpaths ( str / pos )
                (if (setq pos (vl-string-position 59 str))
                        (vl-remove "" (cons (substr str 1 pos) (parsesupportpaths (substr str (+ pos 2)))))
                        (list str)
                )
        )
        (defun parsepatfile ( fn / fd hp ln )
                (if
                        (and
                                (setq fn (findfile fn))
                                (setq fd (open fn "r"))
                        )
                        (progn
                                (while (setq ln (read-line fd))
                                        (if (wcmatch ln "`**`,*")
                                                (setq hp (cons (strcase (substr ln 2 (1- (vl-string-position 44 ln)))) hp))
                                        )
                                )
                                (close fd)
                                (reverse hp)
                        )
                )
        )
       
        (foreach dir (cons (getvar 'dwgprefix) (parsesupportpaths (getenv "ACAD")))
                (foreach pat (vl-directory-files dir "*.pat" 1)
                        (setq lst (cons (parsepatfile (strcat (fixdir dir) "\\" pat)) lst))
                )
        )
        (vl-sort (unique (apply 'append lst)) '<)
)

xiaocainiao 发表于 2023-6-7 20:58:16

飞雪神光 发表于 2023-6-7 20:37


你这个程序我在论坛里面搜到过、但是我想要的不是这个、我想要的就是截图那个对话框里面的填充图案名、主要是想判断某一个填充是否能用MA去刷

kucha007 发表于 2023-6-7 21:30:39

本帖最后由 kucha007 于 2023-6-7 21:32 编辑

xiaocainiao 发表于 2023-6-7 20:58
你这个程序我在论坛里面搜到过、但是我想要的不是这个、我想要的就是截图那个对话框里面的填充图案名、主 ...
试试这样，抓取一下错误？

(setq HPNam (cdr (Assoc 2 (Entget (car (nentsel))))))
(if (not (vl-catch-all-error-p (vl-catch-all-apply 'setvar (list "HPNAME" HPNam))))
(princ "\n图案存在")
(princ "\n图案不存在")
)
(princ)

czb203 发表于 2023-6-7 22:18:17

飞雪神光 发表于 2023-6-7 20:37


神光大侠哪里有您的身影，厉害了

飞雪神光 发表于 2023-6-7 22:56:50

czb203 发表于 2023-6-7 22:18
神光大侠哪里有您的身影，厉害了

闲着没事就上来逛逛嫖点代码

cq4920 发表于 2023-6-7 22:57:33

(defun c:ListHatchPatterns (/ ss i)
(setq ss (ssget "_X" '((0 . "HATCH"))))
(if ss
    (progn
      (setq i 0)
      (while (< i (sslength ss))
      (setq ent (ssname ss i))
      (setq patname (cdr (assoc 2 (entget ent))))
      (princ (strcat "\n" patname))
      (setq i (1+ i))
      )
    )
    (princ "\nNo hatch patterns found.")
)
(princ)
)

飞雪神光 发表于 2023-6-7 22:57:54

xiaocainiao 发表于 2023-6-7 20:58
你这个程序我在论坛里面搜到过、但是我想要的不是这个、我想要的就是截图那个对话框里面的填充图案名、主 ...

我测试的是对话框里面的都出来了

xiaocainiao 发表于 2023-6-8 09:05:02

飞雪神光 发表于 2023-6-7 22:57
我测试的是对话框里面的都出来了

对话框里面的会出来、但是一些用不了的填充也会出来、我主要是想要判断图纸中的某一个填充是否可以使用、你发到这个程序是获取文件中的所有填充

xiaocainiao 发表于 2023-6-8 09:06:13

kucha007 发表于 2023-6-7 21:30
试试这样，抓取一下错误？

我试了一下貌似不太行、不过还是非常感谢

查看完整版本: 请教如何用LISP获取CAD中的所有填充图案名