[编程申请]：给大家出个题吧，想想有什么好的思路

青马 · 发表于 2005-9-15 18:40:31

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

今天看同事在用探索者，里面个有墙填充感觉有些意思，看下图，如果用大红框选，就把墙线都填充了，这时的墙线是line,不是pline,
也不一定是封闭的，也就是我在图上画的小红框上的意思，有什么想法吗，感觉这个命令会在很多地方都可以用到，当然，这个命令是可以过滤选择的，在有轴线，标注等时也可以过滤出wall层的线噢

狂刀 · 发表于 2005-9-15 20:38:58

好像没什么难度，用ｐｅｄｉｔ＋填充就可以

青马 · 发表于 2005-9-15 20:56:15

明白了，刚才试了一下pedit,里面有可以选多条线，再合并，还有那么多选项，把这个命令我所想的难点就都解决了，看来熟悉内部命令各选项真是太有用了，惭愧啊

xyp1964 · 发表于 2005-9-15 22:41:53

pedit不能实现过滤，不封闭就不能填充。

[FONT=courier new](load "xyp_lib")
;|加载通用函数(可在签名栏直接下载)
如果已经下载xyp_lib并放到搜索路径下可以不再下载!
利用以下任何一种方式即可加载和运行通用函数内的所有子程序：
1.在acad.lsp中增加(load"xyp_lib")
2.在每个程序内增加(load"xyp_lib")
3.在command下，输入(load"xyp_lib")
4.在菜单.mnl中增加(load"xyp_lib")
5.将xyp_lib.vlx文件直接拽到cad屏幕
[COLOR=red] ★通用函数下载地址：[/COLOR]
[url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]
[url]http://www.mjtd.com/bbs/dispbbs.asp?boardID=3&ID=37554&page=1[/url]|;
;;;墙体填充
(defun c:test ()
(CMDLA0)
(setq ss (ssget '((0 . "LINE,*POLYLINE,ARC") (8 . "WALLD")))
S1 (ssname ss 0)
)
(if S1
(progn
(setq entype (dxf 0 (entget S1)))
(if (or (= entype "LINE") (= entype "ARC"))
(command "pedit" S1 "y" "j" ss "" "w" "0" "")
(command "pedit" S1 "j" ss "" "w" "0" "")
)
)
)
(setq s2 (entlast)
pts (vlax-curve-getstartPoint s2)
pte (vlax-curve-getendPoint s2)
)
(mkla "填充" 8)
(cond ((equal pts pte)
(command "hatch" "solid" s2 "")
(command "explode" s2 "")
)
(T
(command "pedit" s2 "c" "")
(command "hatch" "solid" s2 "")
(command "explode" s2 "")
(command "erase" "l" "")
)
)
(CMDLA1)
)[/FONT]

[FONT=courier new](load "xyp_lib") 
;|加载通用函数(可在签名栏直接下载) 
如果已经下载xyp_lib并放到搜索路径下可以不再下载! 
利用以下任何一种方式即可加载和运行通用函数内的所有子程序： 
1.在acad.lsp中增加(load"xyp_lib") 
2.在每个程序内增加(load"xyp_lib") 
3.在command下，输入(load"xyp_lib") 
4.在菜单.mnl中增加(load"xyp_lib") 
5.将xyp_lib.vlx文件直接拽到cad屏幕 
[COLOR=red] ★通用函数下载地址：[/COLOR] 
[url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url] 
[url]http://www.mjtd.com/bbs/dispbbs.asp?boardID=3&ID=37554&page=1[/url]|; 
 
;;;墙体填充 
(defun c:test () 
  (CMDLA0) 
  (setq        ss (ssget '((0 . "LINE,*POLYLINE,ARC") (8 . "WALLD"))) 
        S1 (ssname ss 0) 
  ) 
  (if S1 
    (progn 
      (setq entype (dxf 0 (entget S1))) 
      (if (or (= entype "LINE") (= entype "ARC")) 
        (command "pedit" S1 "y" "j" ss "" "w" "0" "") 
        (command "pedit" S1 "j" ss "" "w" "0" "") 
      ) 
    ) 
  ) 
  (setq        s2   (entlast) 
        pts  (vlax-curve-getstartPoint s2) 
        pte  (vlax-curve-getendPoint s2) 
  ) 
  (mkla "填充" 8) 
  (cond        ((equal pts pte) 
         (command "hatch" "solid" s2 "") 
         (command "explode" s2 "") 
        ) 
        (T 
         (command "pedit" s2 "c" "") 
         (command "hatch" "solid" s2 "") 
         (command "explode" s2 "") 
         (command "erase" "l" "") 
        ) 
  ) 
  (CMDLA1) 
)[/FONT]

青马 · 发表于 2005-9-16 00:03:48

xyp,你的这种想法和我先前的一样，但不对，你可以试试
(command "pedit" "m"  ss "" "y" "J" "J" "b" 400(这个数是可自己写的，就可以封口了) "")

这里面还有一个问题我没想出怎么办，就是把这些line都变成了pline,因为封了口，expole后就会多线，所以有什么办法命令执行完后，原来的line还是那些，就多了填充，我现在想的是选完ss后，copyclip,完事后erase那些连接好的pline,再把复制的东西粘贴到原坐标点_pasteorig,我没有想出更好的别的办法

试着编了一下，大形是有了，我说的那点还没有解决，要不就是把最后的pline删了，要不就是炸开，但最后短线会增多，我说的那种copy加paste不行
(defun c:ll ()
  (CMDLA0)
  (setq ss (ssget '((0 . "LINE") (8 . "WALL")))
  )
  (command "_copyclip" ss "")
(command "pedit" "m" ss "" "y" "J" "J" "b" 900 "")
  (setq ss2 (ssget "x" '((8 . "wall"))))
  (setq sl (sslength ss2)
sn (ssname ss2 0)
i  0
  )

  (mkla "填充" 8)
  (repeat sl
(progn
   (setq sn (ssname ss2 i))
   (command "hatch" "solid" sn "")
   (setq i (+ i 1))
)
  );为了不选重多条pline后填充成为一体，一个封闭pline一个填充
  (command "erase" ss2 "")
  (command "_pasteorig")
(CMDLA1)
)

狂刀 · 发表于 2005-9-16 07:22:06

原来线条拷贝到　工作层　如“ｗａｌｌｈａｔｃｈ”层，填充后，删除ｗａｌｌｈａｔｃｈ层的　*ｌｉｎｅ

青马 · 发表于 2005-9-16 18:44:35

改了一下，可以了，不过要加载xyp的通用函数

(defun c:ll ( / i sl sn ss ss1 ss2)
(command "undo" "be")
(CMDLA0)
(setq ss (ssget '((0 . "LINE") (8 . "WALL"))))
(mkla1 "templine")
(command "copy" ss "" "@" "@" "change" ss "" "p" "la" "templine" "") ; (command
; "_copyclip" ss "")
(setq ss1 (ssget "x" '((8 . "templine"))))
(command "pedit" "m" ss1 "" "y" "J" "J" "b" 900 "")
(setq ss2 (ssget "x" '((8 . "templine"))))
(setq sl (sslength ss2)
sn (ssname ss2 0)
i 0
)
(mkla "墙体填充" 8)
(repeat sl
(progn
(setq sn (ssname ss2 i))
(command "hatch" "solid" sn "")
(setq i (+ i 1))
)
) ; 为了不选重多条pline后填充成为一体，
; 一个封闭pline一个填充
(command "erase" ss2 "" "purge" "la" "templine" "n")
;; (command "_pasteorig")
(CMDLA1)
(command "undo" "end")
(prin1)
)

(defun c:ll ( / i sl sn ss ss1 ss2) 
   (command "undo" "be") 
  (CMDLA0) 
  (setq ss (ssget '((0 . "LINE") (8 . "WALL")))) 
  (mkla1 "templine") 
  (command "copy" ss "" "@" "@" "change" ss "" "p" "la" "templine" "")        ; (command 
                                       ; "_copyclip" ss "") 
  (setq ss1 (ssget "x" '((8 . "templine")))) 
  (command "pedit" "m" ss1 "" "y" "J" "J" "b" 900 "") 
  (setq ss2 (ssget "x" '((8 . "templine")))) 
  (setq sl (sslength ss2) 
        sn (ssname ss2 0) 
        i 0 
  ) 
 
  (mkla "墙体填充" 8) 
  (repeat sl 
    (progn 
      (setq sn (ssname ss2 i)) 
      (command "hatch" "solid" sn "") 
      (setq i (+ i 1)) 
    ) 
  )                                       ; 为了不选重多条pline后填充成为一体， 
                                       ; 一个封闭pline一个填充 
  (command "erase" ss2 "" "purge" "la" "templine" "n") 
  ;; (command "_pasteorig") 
  (CMDLA1) 
  (command "undo" "end") 
  (prin1) 
  )

狂刀 · 发表于 2005-9-17 04:55:46

我作的效果

xyp1964 · 发表于 2005-9-17 18:11:47

最初由青马发布
[B]改了一下，可以了，不过要加载xyp的通用函数[/B]

[php](defun c:test ()
  (CMDLA0)
  (setq ss (ssget '((0 . "LINE,*POLYLINE,ARC") (8 . "WALL,WALLD"))))
  (mkla "templine" 1)
  (command "copy"
   ss
   ""
   (list 0 0)
   (list 0 0)
   "change"
   ss
   ""
   "p"
   "la"
   "templine"
   "c"
   1
   ""
  )
  (setq ss1 (ssget "x" '((0 . "*POLYLINE") (8 . "templine"))))
  (if ss1
(command "explode" ss1 "")
  )
  (setq ss1 (ssget "x" '((8 . "templine"))))
  (command "pedit" "m" ss1 "" "y" "J" "J" "b" 500 "")
  (setq ss1 (ssget "x" '((8 . "templine"))))
  (setq sl (sslength ss1)
i  -1
  )
  (mkla "墙体填充" 8)
  (repeat sl
(setq sn (ssname ss1 (setq i (1+ i))))
(command "hatch" "solid" sn "")
  )
  (CMDLA1)
  (command "erase" ss1 "" "purge" "la" "templine" "n")
  (princ)
)[/php]

狂刀 · 发表于 2005-9-18 01:11:40

不错，不错，和我的程序小小的区别是：
框选一个矩形房间的墙体的时候。。。。。。

青马 · 发表于 2005-9-26 20:49:43

最初由狂刀发布
[B]不错，不错，和我的程序小小的区别是：
框选一个矩形房间的墙体的时候。。。。。。 [/B]

狂刀，你的程序是什么样的啊，说说，我发现这个程序的问题了，要是框选一个矩形房间，可能会把房间里面也给填上

狂刀 · 发表于 2005-9-27 03:21:48

是什么样？
8楼已经有演示了阿，演示的最末就是填充闭合部分墙体的示例

xiejianchao · 发表于 2005-9-27 09:20:17

很难搞懂,真深奥,看来要改主意,学点别的了

青马 · 发表于 2005-9-28 01:26:18

看到了，我的机子有问题，一直是一个静止的图，你的那个为什么可以那么填充啊，是怎么农的

账号		自动登录	找回密码
密码			立即注册

[编程申请]：给大家出个题吧，想想有什么好的思路

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

浏览过的版块