kingisland99762 发表于 2022-7-6 12:13:03

Lisp程序

下面是我想通过使用lisp例程实现的功能：
将所有线条和线型放置在图层“0”上
检查所有文本是否位于层“0”上，如果不是，则放置在层“0”上
将所有文字样式更改为Arial
删除tiff图像，无论其位于哪一层
删除层名称Tiff\U图像
清除所有文件至少3次，以确保文件中没有任何内容
最大化显示
快速保存
关
有人能帮我完成这项任务吗？

JohnM 发表于 2022-7-6 12:23:46

将所有线条和线型放置在层“0”上（这是什么意思？）
检查所有文本是否位于层“0”上，如果不是，则放置在层“0”上（完成）
将所有文本样式更改为Arial（您有一种名为Arial的样式，还是您指的是字体？）
删除tiff图像，无论其位于哪一层（完成）
删除层名称Tiff_图像（如果该层上没有其他对象，则清除将解决此问题）
清除所有文件至少3次，以确保文件中没有任何内容
（完成）
最大化显示（完成）
快速保存（完成）
关闭（完成）
 

(defun c:tip (/ ss ss1 en1 cnt en pth)

;;; change all text not on layer 0 to layer 0
(setq ss1(ssget "X"
       '((0 . "MTEXT,TEXT")(410 . "Model")
       (-4 . "<NOT")(8 . "0")(-4 . "NOT>"))
       );_ssget
       );_setq
(if ss1
       (progn
(setq cnt 0)
       (while (< cnt (sslength ss1))
(setq en1(vlax-ename->vla-object(ssname ss1 cnt)))
       (vla-put-layer en1 "0")
       (setq cnt (1+ cnt))
       );_while
       );_progn
       );_if
;;;***delete all TIFF files in model space
(setq ss (ssget "_X" '((0 . "IMAGE")(410 . "Model"))))
(if ss
       (progn
(setq cnt 0)      
(while (< cnt (sslength ss))
      (setq en(vlax-ename->vla-object(ssname ss cnt)))               
(setq pth(vla-get-imagefile en))
       (if(=(strcase(vl-filename-extension pth))".TIFF")
(command "-image" "detach" (vl-filename-base pth))
       );_if
(setq cnt (1+ cnt))
       );_while
       );_progn
       );_if
;;;*** purge 3 times***
(command "-purge" "ALL" "" "NO")
(command "-purge" "ALL" "" "NO")
(command "-purge" "ALL" "" "NO")

;;;*** zoom extence
(command "zoom" "extents")

;;;*** quick save
(command "qsave")

;;;*** close
(command "close")
(princ)
);_defun

 
因为我只做了一半的工作，所以我只收50万美元
请记入我的paypal帐户。

alanjt 发表于 2022-7-6 12:29:45

该死！我想要一块。

David Bethel 发表于 2022-7-6 12:34:15

我找了，但没找到。如何在纯Autolisp中找到图像文件名-大卫

alanjt 发表于 2022-7-6 12:39:42

它在字典里。。。。。。我很确定这是真的。

David Bethel 发表于 2022-7-6 12:48:05

谢谢我去看看-大卫

fixo 发表于 2022-7-6 12:50:21

当然是的

(setq imagename (cdr (assoc 1
       (entget (cdr (assoc 340 (entget en))))))
 
~'J'~

David Bethel 发表于 2022-7-6 12:58:44

 
谢谢
 
那么，我会尝试这样的方式：
 
(defun c:cande (/ ss i en ed im)

(and (setq ss (ssget "X" '((0 . "*LINE,*TEXT"))))
      (command "_.CHANGE" ss "" "_P" "_LA" "0" ""))

(cond ((tblsearch "STYLE" "ARIAL"))
       ((or (findfile "ARIAL.SHX")
            (findfile "ARIAL.PFB")
            (findfile "ARIAL.TTF"))
      (command "_.STYLE" "ARIAL" "ARIAL")
      (while (> (getvar "CMDACTIVE") 0)
               (command "")))
       (T
      (command "_.STYLE" "ARIAL" "TXT")
      (while (> (getvar "CMDACTIVE") 0)
               (command ""))))

(and (setq ss (ssget "X" '((0 . "*TEXT"))))
      (setq i (sslength ss))
      (while (not (minusp (setq i (1- i))))
             (setq en (ssname ss i)
                   ed (entget en))
             (entmod (subst (cons 7 "ARIAL") (assoc 7 ed) ed))))

(and (setq ss (ssget "X" '((0 . "IMAGE"))))
      (setq i (sslength ss))
      (while (not (minusp (setq i (1- i))))
             (setq en (ssname ss i)
                   im (cdr (assoc 1 (entget (cdr (assoc 340 (entget en)))))))
             (if (= ".TIF" (substr im (- (strlen im) 4)))
               (entdel en))))

(while (> (getvar "DBMOD") 0)
      (command "_.PURGE" "_All" "_No"))

(command "_.ZOOM" "_E"
          "_.QSAVE"
          "_.CLOSE")

(prin1))
 
未经测试-David

kingisland99762 发表于 2022-7-6 13:02:10

嘿，非常感谢，付款将由阿拉斯加的狗队发送，到达后请告诉我。。。。。。
 
吉米

mdbdesign 发表于 2022-7-6 13:12:09

 
犬因H1N1在加拿大边境被拦下
页: [1] 2
查看完整版本: Lisp程序