请求大侠帮修改下，想有两种选择填充方式，一种是直接吸取内框填充另一种选择矩行填充

Aenda

gaics 发表于 2014-5-12 21:52
改了什么？

跟16楼很像的 差不多，我的比他的还好点点

edata

1. (defun c:q(/ p lst ss ent00 cmd_old)
   
2.   (vl-load-com)
   
3.   (setq lst '() cmd_old(getvar 'cmdecho) ent00(entlast))
   
4.   (setvar 'cmdecho 0)  
   
5.   (if (setq ss(ssget '((0 . "*line,arc,ellipse,circle"))))
   
6.     (progn
   
7.       (command "-HATCH" "p" "ansi31" "15" "0" "s" ss "" )
   
8.       (while(setq p(getpoint))(command p))
   
9.       (command "")      
   
10.       (if (and ent00 (/= (cdr(assoc 5 (entget(entlast)))) (cdr(assoc 5 (entget ent00)))))
    
11.         (progn
    
12.           (vlax-put(vlax-ename->vla-object(entlast))'color 250)
    
13.           (princ "ok!")
    
14.           )
    
15.         (princ "The hatch object creat unsuccessfully!"))
    
16.       )
    
17.     (progn
    
18.       (command "-HATCH" "p" "ansi31" "15" "0")
    
19.       (while(setq p(getpoint))(command p))
    
20.       (command "")
    
21.       (if (and ent00 (/= (cdr(assoc 5 (entget(entlast)))) (cdr(assoc 5 (entget ent00)))))
    
22.         (progn
    
23.           (vlax-put(vlax-ename->vla-object(entlast))'color 250)
    
24.           (princ "ok!")
    
25.           )
    
26.         (princ "The hatch object creat unsuccessfully!"))
    
27.       
    
28.       )
    
29.     )
    
30.   (and cmd_old (setvar 'cmdecho cmd_old))
    
31.   (princ)
    
32.   )

(defun c:q(/ p lst ss ent00 cmd_old)<br />   (vl-load-com)<br />   (setq lst '() cmd_old(getvar 'cmdecho) ent00(entlast))<br />   (setvar 'cmdecho 0)  <br />   (if (setq ss(ssget '((0 . "*line,arc,ellipse,circle"))))<br />     (progn<br />       (command "-HATCH" "p" "ansi31" "15" "0" "s" ss "" )<br />       (while(setq p(getpoint))(command p))<br />       (command "")      <br />       (if (and ent00 (/= (cdr(assoc 5 (entget(entlast)))) (cdr(assoc 5 (entget ent00)))))<br />         (progn<br />           (vlax-put(vlax-ename->vla-object(entlast))'color 250)<br />           (princ "ok!")<br />           )<br />         (princ "The hatch object creat unsuccessfully!"))<br />       )<br />     (progn<br />       (command "-HATCH" "p" "ansi31" "15" "0")<br />       (while(setq p(getpoint))(command p))<br />       (command "")<br />       (if (and ent00 (/= (cdr(assoc 5 (entget(entlast)))) (cdr(assoc 5 (entget ent00)))))<br />         (progn<br />           (vlax-put(vlax-ename->vla-object(entlast))'color 250)<br />           (princ "ok!")<br />           )<br />         (princ "The hatch object creat unsuccessfully!"))<br />       <br />       )<br />     )<br />   (and cmd_old (setvar 'cmdecho cmd_old))<br />   (princ)<br />   )

Aenda

edata 发表于 2014-5-13 15:09

    ，已经很完美了，。  好像你这改动  意义在于可以同时选对象跟点选，...某些时候是比较方便，但是某些时候又觉得有点多余，很不错，赞一个，非常感谢

Aenda

edata 发表于 2014-5-13 15:09

edata  ,能我帮看看我源码问题吗？ 不知道为什么有时候画着画着图，捕捉自动全部关闭了 ，还有颜色也自动跳到250号色。谢谢
(defun c:Q1 (/ s1 pt oldcolor snap)
(setq oldcolor (getvar "cecolor"))
(setq snap (getvar "osmode"))
(setvar "cecolor" "250")
(setvar "osmode" 0)
(princ "\n默认<拾取点>方式按右键或空格切换到<选择对象>方式:")
(if(setq pt(getpoint"\n指定内部点"))
  (progn
    (command "BHATCH" "p" "ansi31" "6" "0")
    (while pt(command pt)(setq pt(getpoint)))
    (command ""))
  (if(setq s1 (ssget))
    (command "BHATCH" "p" "ansi31" "6" "0" "s" s1 "" ""))
  )
(setvar "cecolor" oldcolor)
(setvar "osmode" snap)
(princ)
)

edata

Aenda 发表于 2014-5-14 10:51
edata  ,能我帮看看我源码问题吗？ 不知道为什么有时候画着画着图，捕捉自动全部关闭了 ，还有颜色也自动 ...

因为你前面设置了当前颜色为250，捕捉关闭，
但是如果程序出现错误将不执行恢复，也就是倒数第四行和第五行没有哦执行，也就造成了当前颜色和捕捉被更改，无法复原。
你可以加入出错处理程序，可以在论坛搜到，也可以参考我最后的代码，因为我只改变了cmdecho变量，即使出错了，影响也不是很大。

Aenda

edata 发表于 2014-5-14 11:10
因为你前面设置了当前颜色为250，捕捉关闭，
但是如果程序出现错误将不执行恢复，也就是倒数第四行和第五 ...

edata, 谢谢你的热心指导，我懂了，
能在我基础上编写一个完整的吗？ 我是新手不太懂，谢谢...

peraperson

Aenda 发表于 2014-5-14 10:51
edata  ,能我帮看看我源码问题吗？ 不知道为什么有时候画着画着图，捕捉自动全部关闭了 ，还有颜色也自动 ...

(defun c:Q1 (/ s1 pt oldcolor snap)
(dfl_var)
(setvar "cecolor" "250")
(setvar "osmode" 0)
(princ "\n默认<拾取点>方式按右键或空格切换到<选择对象>方式:")
(if(setq pt(getpoint"\n指定内部点"))
  (progn
    (command "BHATCH" "p" "ansi31" "6" "0")
    (while pt(command pt)(setq pt(getpoint)))
    (command ""))
  (if(setq s1 (ssget))
    (command "BHATCH" "p" "ansi31" "6" "0" "s" s1 "" ""))
  )
(*error* nil)
(princ)
)



(defun dfl_var ()
(setq e_lst (mapcar (function (lambda (n) (list 'setvar n (getvar n))))
'("cecolor" "clayer"  "autosnap" "osmode"  )))
(defun *error* (msg) (mapcar 'eval e_lst))
)

Aenda

peraperson 发表于 2014-5-14 12:19
(defun c:Q1 (/ s1 pt oldcolor snap)
(dfl_var)
(setvar "cecolor" "250")

兄台，可以可行吗？

Aenda

edata 发表于 2014-5-14 11:10
因为你前面设置了当前颜色为250，捕捉关闭，
但是如果程序出现错误将不执行恢复，也就是倒数第四行和第五 ...

大神，能帮帮我优化下吗 ，楼下那个也不行耶。还是会失去捕捉。

Aenda

peraperson 发表于 2014-5-14 12:19
(defun c:Q1 (/ s1 pt oldcolor snap)
(dfl_var)
(setvar "cecolor" "250")

还是不行，捕捉还原不了