找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 661|回复: 4

[求助] [求助]:高手指教(关于BHATCH边界的)

[复制链接]
发表于 2006-1-13 14:19:36 | 显示全部楼层 |阅读模式

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

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

×
请问高手如何在程序中获取BHATCH生成的边界?(ENTLAST)只能取得HATCH!!!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
发表于 2006-1-13 21:50:31 | 显示全部楼层

注:本程序为转贴!

以前看到过这么一个程序,主要是生成“图案填充”边界的,你可以看看!
  1. ;;; HATCHB.LSP ver 1.6
  2. ;;; Recreates hatch boundary by selecting a hatch
  3. ;;; Boundary is created in current layer/color/linetype in WCS
  4. ;;; By Jimmy Bergmark
  5. ;;; Copyright (C) 1997-2002 JTB World, All Rights Reserved
  6. ;;; Website: [url]www.jtbworld.com[/url] / [url]http://jtbworld.vze.com[/url]
  7. ;;; E-mail: [email]info@jtbworld.com[/email] / [email]jtbworld@hotmail.com[/email]
  8. ;;; 2000-02-12 - First release
  9. ;;; 2000-03-27 - Counterclockwise arc's and ellipse's fixed
  10. ;;;              Objects created joined to lwpolyline if possible
  11. ;;;              Error-handling, undo of command
  12. ;;;              Can handle PLINETYPE = 0,1,2
  13. ;;; 2000-03-30 - Integrating hatchb and hatchb14
  14. ;;;              Selection of many hatches
  15. ;;;              Splines supported if closed.
  16. ;;; 2001-04-02 - Fixed bug with entmake of line with no Z for r14
  17. ;;; 2001-07-31 - Removed an irritating semicolon to enable polylines to be created.
  18. ;;; 2001-10-04 - Changed mail and homepage so it's easy to find when new versions comes up.
  19. ;;; Tested on AutoCAD r14, 2000, 2000i, 2002
  20. ;;; should be working on older versions too.

  21. (defun c:hb () (c:hatchb))                ; this line can be commented out if there is an existing command called hb
  22. (defun c:hatchb        (/            es               blay          ed1             ed2
  23.                  loops1            bptf       part          et             noe
  24.                  plist            ic               bul          nr             ang1
  25.                  ang2            obj               *ModelSpace*
  26.                  *PaperSpace*               space          cw             errexit
  27.                  undox            olderr     oldcmdecho ss1             lastent
  28.                  en1            en2               ss          lwp
  29.                  list->variantArray    3dPoint->2dPoint             A2k
  30.                  ent            i               ss2          knot-list
  31.                  controlpoint-list     kn          cn             pos
  32.                  xv
  33.                 )
  34.   (setq A2k (wcmatch (getvar "ACADVER") "15*"))
  35.   (if A2k
  36.     (defun list->variantArray (ptsList / arraySpace sArray)
  37.       (setq arraySpace
  38.              (vlax-make-safearray
  39.                vlax-vbdouble
  40.                (cons 0 (- (length ptsList) 1))
  41.              )
  42.       )
  43.       (setq sArray (vlax-safearray-fill arraySpace ptsList))
  44.       (vlax-make-variant sArray)
  45.     )
  46.   )
  47.   (if A2k
  48.     (defun 3dPoint->2dPoint (3dpt)
  49.       (list (float (car 3dpt)) (float (cadr 3dpt)))
  50.     )
  51.   )

  52.   (defun errexit (s)
  53.     (princ "\nError:  ")
  54.     (princ s)
  55.     (restore)
  56.   )

  57.   (defun undox ()
  58.     (command "._ucs" "_p")
  59.     (command "._undo" "_E")
  60.     (setvar "cmdecho" oldcmdecho)
  61.     (setq *error* olderr)
  62.     (princ)
  63.   )

  64.   (setq        olderr        *error*
  65.         restore        undox
  66.         *error*        errexit
  67.   )
  68.   (setq oldcmdecho (getvar "cmdecho"))
  69.   (setvar "cmdecho" 0)
  70.   (command "._UNDO" "_BE")
  71.   (if A2k
  72.     (progn
  73.       (vl-load-com)
  74.       (setq *ModelSpace* (vla-get-ModelSpace
  75.                            (vla-get-ActiveDocument (vlax-get-acad-object))
  76.                          )
  77.             *PaperSpace* (vla-get-PaperSpace
  78.                            (vla-get-ActiveDocument (vlax-get-acad-object))
  79.                          )
  80.       )
  81.     )
  82.   )


  83.                                         ; For testing purpose
  84.                                         ; (setq A2k nil)

  85.   (if (/= (setq ss2 (ssget '((0 . "HATCH")))) nil)
  86.     (progn
  87.       (setq i 0)
  88.       (while (setq ent (ssname ss2 i))
  89.         (setq ed1 (entget ent))
  90.         (if (not (equal (assoc 210 ed1) '(210 0.0 0.0 1.0)))
  91.           (princ "\nHatch not in WCS!")
  92.         )
  93.         (setq xv (cdr (assoc 210 ed1)))
  94.         (command "._ucs" "_w")
  95.         (setq loops1 (cdr (assoc 91 ed1)))
  96.                                         ; number of boundary paths (loops)
  97.         (if (and A2k (= (strcase (cdr (assoc 410 ed1))) "MODEL"))
  98.           (setq space *ModelSpace*)
  99.           (setq space *PaperSpace*)
  100.         )
  101.         (repeat        loops1
  102.           (setq ed1 (member (assoc 92 ed1) ed1))
  103.           (setq bptf (cdr (car ed1)))        ; boundary path type flag
  104.           (setq ic (cdr (assoc 73 ed1))) ; is closed
  105.           (setq noe (cdr (assoc 93 ed1))) ; number of edges
  106.           (setq ed1 (member (assoc 72 ed1) ed1))
  107.           (setq bul (cdr (car ed1)))        ; bulge
  108.           (setq plist nil)
  109.           (setq blist nil)
  110.           (cond
  111.             ((> (boole 1 bptf 2) 0)        ; polyline
  112.              (repeat noe
  113.                (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
  114.                (setq plist (append plist (list (cdr (assoc 10 ed1)))))
  115.                (setq blist (append blist
  116.                                    (if (> bul 0)
  117.                                      (list (cdr (assoc 42 ed1)))
  118.                                      nil
  119.                                    )
  120.                            )
  121.                )
  122.              )
  123.              (if A2k
  124.                (progn
  125.                  (setq polypoints
  126.                         (apply 'append
  127.                                (mapcar '3dPoint->2dPoint plist)
  128.                         )
  129.                  )
  130.                  (setq VLADataPts (list->variantArray polypoints))
  131.                  (setq
  132.                    obj (vla-addLightweightPolyline space VLADataPts)
  133.                  )
  134.                  (setq nr 0)
  135.                  (repeat (length blist)
  136.                    (if (/= (nth nr blist) 0)
  137.                      (vla-setBulge obj nr (nth nr blist))
  138.                    )
  139.                    (setq nr (1+ nr))
  140.                  )
  141.                  (if (= ic 1)
  142.                    (vla-put-closed obj T)
  143.                  )
  144.                )
  145.                (progn
  146.                  (if (= ic 1)
  147.                    (entmake '((0 . "POLYLINE") (66 . 1) (70 . 1)))
  148.                    (entmake '((0 . "POLYLINE") (66 . 1)))
  149.                  )
  150.                  (setq nr 0)
  151.                  (repeat (length plist)
  152.                    (if (= bul 0)
  153.                      (entmake (list (cons 0 "VERTEX")
  154.                                     (cons 10 (nth nr plist))
  155.                               )
  156.                      )
  157.                      (entmake (list (cons 0 "VERTEX")
  158.                                     (cons 10 (nth nr plist))
  159.                                     (cons 42 (nth nr blist))
  160.                               )
  161.                      )
  162.                    )
  163.                    (setq nr (1+ nr))
  164.                  )
  165.                  (entmake '((0 . "SEQEND")))
  166.                )
  167.              )
  168.             )
  169.             (t                                ; not polyline
  170.              (setq lastent (entlast))
  171.              (setq lwp T)
  172.              (repeat noe
  173.                (setq et (cdr (assoc 72 ed1)))
  174.                (cond
  175.                  ((= et 1)                ; line
  176.                   (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
  177.                   (if A2k
  178.                     (vla-AddLine
  179.                       space
  180.                       (vlax-3d-point (cdr (assoc 10 ed1)))
  181.                       (vlax-3d-point (cdr (assoc 11 ed1)))
  182.                     )
  183.                     (entmake
  184.                       (list
  185.                         (cons 0 "LINE")
  186.                         (list 10
  187.                               (cadr (assoc 10 ed1))
  188.                               (caddr (assoc 10 ed1))
  189.                               0
  190.                         )
  191.                         (list 11
  192.                               (cadr (assoc 11 ed1))
  193.                               (caddr (assoc 11 ed1))
  194.                               0
  195.                         )
  196.                                         ;  (cons 210 xv)
  197.                       )
  198.                     )
  199.                   )
  200.                   (setq ed1 (cddr ed1))
  201.                  )
  202.                  ((= et 2)                ; circular arc
  203.                   (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
  204.                   (setq ang1 (cdr (assoc 50 ed1)))
  205.                   (setq ang2 (cdr (assoc 51 ed1)))
  206.                   (setq cw (cdr (assoc 73 ed1)))
  207.                   (if (equal ang2 6.28319 0.00001)
  208.                     (progn
  209.                       (if A2k
  210.                         (vla-AddCircle
  211.                           space
  212.                           (vlax-3d-point (cdr (assoc 10 ed1)))
  213.                           (cdr (assoc 40 ed1))
  214.                         )
  215.                         (entmake (list (cons 0 "CIRCLE")
  216.                                        (assoc 10 ed1)
  217.                                        (assoc 40 ed1)
  218.                                  )
  219.                         )
  220.                       )
  221.                       (setq lwp nil)
  222.                     )
  223.                     (if        A2k
  224.                       (vla-AddArc
  225.                         space
  226.                         (vlax-3d-point (cdr (assoc 10 ed1)))
  227.                         (cdr (assoc 40 ed1))
  228.                         (if (= cw 0)
  229.                           (- 0 ang2)
  230.                           ang1
  231.                         )
  232.                         (if (= cw 0)
  233.                           (- 0 ang1)
  234.                           ang2
  235.                         )
  236.                       )
  237.                       (entmake (list (cons 0 "ARC")
  238.                                      (assoc 10 ed1)
  239.                                      (assoc 40 ed1)
  240.                                      (cons 50
  241.                                            (if (= cw 0)
  242.                                              (- 0 ang2)
  243.                                              ang1
  244.                                            )
  245.                                      )
  246.                                      (cons 51
  247.                                            (if (= cw 0)
  248.                                              (- 0 ang1)
  249.                                              ang2
  250.                                            )
  251.                                      )
  252.                                )
  253.                       )
  254.                     )
  255.                   )
  256.                   (setq ed1 (cddddr ed1))
  257.                  )
  258.                  ((= et 3)                ; elliptic arc
  259.                   (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
  260.                   (setq ang1 (cdr (assoc 50 ed1)))
  261.                   (setq ang2 (cdr (assoc 51 ed1)))
  262.                   (setq cw (cdr (assoc 73 ed1)))
  263.                   (if A2k
  264.                     (progn
  265.                       (setq obj        (vla-AddEllipse
  266.                                   space
  267.                                   (vlax-3d-point (cdr (assoc 10 ed1)))
  268.                                   (vlax-3d-point (cdr (assoc 11 ed1)))
  269.                                   (cdr (assoc 40 ed1))
  270.                                 )
  271.                       )
  272.                       (vla-put-startangle
  273.                         obj
  274.                         (if (= cw 0)
  275.                           (- 0 ang2)
  276.                           ang1
  277.                         )
  278.                       )
  279.                       (vla-put-endangle
  280.                         obj
  281.                         (if (= cw 0)
  282.                           (- 0 ang1)
  283.                           ang2
  284.                         )
  285.                       )
  286.                     )
  287.                     (princ "\nElliptic arc not supported!")
  288.                   )
  289.                   (setq lwp nil)
  290.                  )
  291.                  ((= et 4)                ; spline
  292.                   (setq ed1 (member (assoc 94 (cdr ed1)) ed1))
  293.                   (setq knot-list nil)
  294.                   (setq controlpoint-list nil)
  295.                   (setq kn (cdr (assoc 95 ed1)))
  296.                   (setq cn (cdr (assoc 96 ed1)))
  297.                   (setq pos (vl-position (assoc 40 ed1) ed1))
  298.                   (repeat kn
  299.                     (setq
  300.                       knot-list        (cons (cons 40 (cdr (nth pos ed1)))
  301.                                       knot-list
  302.                                 )
  303.                     )
  304.                     (setq pos (1+ pos))
  305.                   )
  306.                   (setq pos (vl-position (assoc 10 ed1) ed1))
  307.                   (repeat cn
  308.                     (setq controlpoint-list
  309.                            (cons
  310.                              (cons 10 (cdr (nth pos ed1)))
  311.                              controlpoint-list
  312.                            )
  313.                     )
  314.                     (setq pos (1+ pos))
  315.                   )
  316.                   (setq knot-list (reverse knot-list))
  317.                   (setq controlpoint-list (reverse controlpoint-list))
  318.                   (entmake (append
  319.                              (list '(0 . "SPLINE"))
  320.                              (list (cons 100 "AcDbEntity"))
  321.                              (list (cons 100 "AcDbSpline"))
  322.                              (list (cons 70
  323.                                          (+ 1
  324.                                             8
  325.                                             (* 2 (cdr (assoc 74 ed1)))
  326.                                             (* 4 (cdr (assoc 73 ed1)))
  327.                                          )
  328.                                    )
  329.                              )
  330.                              (list (cons 71 (cdr (assoc 94 ed1))))
  331.                              (list (cons 72 kn))
  332.                              (list (cons 73 cn))
  333.                              knot-list
  334.                              controlpoint-list
  335.                            )
  336.                   )
  337.                   (setq ed1 (member (assoc 10 ed1) ed1))
  338.                   (setq lwp nil)
  339.                  )
  340.                )                        ; end cond
  341.              )                                ; end repeat noe
  342.              (if lwp
  343.                (progn
  344.                  (setq en1 (entnext lastent))
  345.                  (setq ss (ssadd))
  346.                  (ssadd en1 ss)
  347.                  (while        (setq en2 (entnext en1))
  348.                    (ssadd en2 ss)
  349.                    (setq en1 en2)
  350.                  )
  351.                  (command "_.pedit" (entlast) "_Y" "_J" ss "" "")
  352.                )
  353.              )
  354.             )                                ; end t
  355.           )                                ; end cond
  356.         )                                ; end repeat loops1
  357.         (setq i (1+ i))
  358.       )
  359.     )
  360.   )
  361.   (restore)
  362.   (princ)
  363. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2006-1-14 09:46:06 | 显示全部楼层

谢谢楼上的

谢谢楼上的,这个程序我有,类似的程序我也写过,可这不是我的目的,我只是想用BHATCH同时生成边界和填充,并取得用BHATCH生成的边界,以便我进一步处理。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2006-1-14 15:29:04 | 显示全部楼层
  1. [FONT=courier new](load "xyp_lib.vlx")                        ;版本 V.20051230 (1873)
  2. ;|下载和加载通用函数(可在签名栏直接下载后放到搜索路径下)
  3. 利用以下任何一种方式(首选第一种)即可加载和运行通用函数内的所有子程序:
  4. ★1·在acad.lsp中增加(load"xyp_lib.vlx")
  5. ■2·在每个程序内增加(load"xyp_lib.vlx")
  6. ■3·在command下,输入(load"xyp_lib.vlx")
  7. ■4·在菜单.mnl中增加(load"xyp_lib.vlx")
  8. ■5·将xyp_lib.vlx文件直接拽到cad屏幕
  9. [COLOR=red] ★通用函数下载地址:[/COLOR]
  10. [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]
  11. |;
  12. (defun c:test ()
  13.   (CMDLA0)
  14.   (setvar "HPNAME" "ANGLE")
  15.   (setvar "HPSCALE" 10)
  16.   (setvar "HPANG" 0)
  17.   (while (setq pt (getpoint "\n选取封闭域内一点: "))
  18.     (mkla "填充边界" 1)
  19.     (command "bpoly" pt "")
  20.     (mkla "填充" 3)
  21.     (command "bhatch" pt "")
  22.   )
  23.   (CMDLA1)
  24. )[/FONT]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2006-1-15 11:50:02 | 显示全部楼层
多谢楼上的,能不用通用函数,而专门写个函数吗?最好源码!!!
再次感谢!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2025-9-29 01:12 , Processed in 0.472545 second(s), 40 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

快速回复 返回顶部 返回列表