明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 6072|回复: 19

如何求填充边界

  [复制链接]
发表于 2005-5-11 18:41:00 | 显示全部楼层 |阅读模式
如何提取出剖面线的填充边界及其属性
发表于 2021-3-29 16:37:13 | 显示全部楼层
路过手册标记一下把
发表于 2005-5-11 21:02:00 | 显示全部楼层
呵呵,最新的AutoCAD 2006中BHATCH命令可以重建填充边界。你可以试试直接用Command函数调用其命令行版本。
发表于 2005-5-11 22:36:00 | 显示全部楼层
先用object.NumberOfLoops 得么边界数


再用object.GetLoopAt Index, Loop 取得数据
发表于 2005-5-12 08:47:00 | 显示全部楼层
这个我也没研究,,,以前帖子里的一个程序,你琢磨一下吧:
  1. ;;;命令:hb或hatchb
  2. ;;;功能:根据填充画出边界线
  3. ;;; HATCHB.LSP ver 2.0
  4. ;;; Recreates hatch boundary by selecting a hatch
  5. ;;; Boundary is created in current layer/color/linetype in WCS
  6. ;;; By Jimmy Bergmark
  7. ;;; Copyright (C) 1997-2003 JTB World, All Rights Reserved
  8. ;;; Website: www.jtbworld.com
  9. ;;; E-mail: info@jtbworld.com
  10. ;;; 2000-02-12 - First release
  11. ;;; 2000-03-27 - Counterclockwise arc's and ellipse's fixed
  12. ;;;                           Objects created joined to lwpolyline if possible
  13. ;;;                           Error-handling, undo of command
  14. ;;;                           Can handle PLINETYPE = 0,1,2
  15. ;;; 2000-03-30 - Integrating hatchb and hatchb14
  16. ;;;                           Selection of many hatches
  17. ;;;                           Splines supported if closed.
  18. ;;; 2001-04-02 - Fixed bug with entmake of line with no Z for r14
  19. ;;; 2001-07-31 - Removed an irritating semicolon to enable polylines to be created.
  20. ;;; 2001-10-04 - Changed mail and homepage so it's easy to find when new versions comes up.
  21. ;;; 2003-02-06 - Minor fix
  22. ;;; 2003-02-17 - Area returned if no islands is found since it's not consistant
  23. ;;; 2003-05-19 - Fix to take PEDITACCEPT variable used in AutoCAD 2004 into account
  24. ;;; Tested on AutoCAD r14, 2000, 2000i, 2002, 2004
  25. ;;; should be working on older versions too.
  26. (defun c:hb () (c:hatchb))   ; this line can be commented out if there is an existing command called hb
  27. (defun c:hatchb (/       es           blay           ed1   ed2
  28.      loops1       bptf           part           et   noe
  29.      plist       ic           bul             nr   ang1
  30.      ang2       obj           *ModelSpace*   *PaperSpace*
  31.      space       cw           errexit     undox   olderr
  32.      oldcmdecho           ss1             lastent   en1
  33.      en2       ss           lwp             list->variantArray
  34.      3dPoint->2dPoint       A2k             ent   i
  35.      ss2       knot-list controlpoint-list   kn
  36.      cn       pos           xv               bot   area
  37.      hst
  38.    )
  39.    (setq A2k (>= (substr (getvar "ACADVER") 1 2) "15"))
  40.    (if A2k
  41.        (progn
  42.            (defun list->variantArray (ptsList / arraySpace sArray)
  43.   (setq arraySpace
  44.                (vlax-make-safearray
  45.      vlax-vbdouble
  46.      (cons 0 (- (length ptsList) 1))
  47.                )
  48.   )
  49.   (setq sArray (vlax-safearray-fill arraySpace ptsList))
  50.   (vlax-make-variant sArray)
  51.            )
  52.            (defun areaOfObject (en / curve area)
  53.   (if en
  54.      (if A2k
  55.          (progn
  56.              (setq curve (vlax-ename->vla-object en))
  57.              (if
  58.    (vl-catch-all-error-p
  59.        (setq
  60.            area
  61.              (vl-catch-all-apply 'vlax-curve-getArea (list curve))
  62.        )
  63.    )
  64.      nil
  65.      area
  66.              )
  67.          )
  68.          (progn
  69.              (command "._area" "_O" en)
  70.              (getvar "area")
  71.          )
  72.      )
  73.   )
  74.            )
  75.        )
  76.    )
  77.    (if A2k
  78.        (defun 3dPoint->2dPoint (3dpt)
  79.            (list (float (car 3dpt)) (float (cadr 3dpt)))
  80.        )
  81.    )
  82.    (defun errexit (s)
  83.        (princ "\nError:   ")
  84.        (princ s)
  85.        (restore)
  86.    )
  87.    (defun undox ()
  88.        (command "._ucs" "_p")
  89.        (command "._undo" "_E")
  90.        (setvar "cmdecho" oldcmdecho)
  91.        (setq *error* olderr)
  92.        (princ)
  93.    )
  94.    (setq olderr *error*
  95.   restore undox
  96.   *error* errexit
  97.    )
  98.    (setq oldcmdecho (getvar "cmdecho"))
  99.    (setvar "cmdecho" 0)
  100.    (command "._UNDO" "_BE")
  101.    (if A2k
  102.        (progn
  103.            (vl-load-com)
  104.            (setq *ModelSpace* (vla-get-ModelSpace
  105.            (vla-get-ActiveDocument (vlax-get-acad-object))
  106.        )
  107.          *PaperSpace* (vla-get-PaperSpace
  108.            (vla-get-ActiveDocument (vlax-get-acad-object))
  109.        )
  110.            )
  111.        )
  112.    )         ; For testing purpose
  113.          ; (setq A2k nil)
  114.    (if (/= (setq ss2 (ssget '((0 . "HATCH")))) nil)
  115.        (progn
  116.            (setq i 0)
  117.            (setq area 0)
  118.            (setq bMoreLoops nil)
  119.            (while (setq ent (ssname ss2 i))
  120.   (setq ed1 (entget ent))
  121.   (if (not (equal (assoc 210 ed1) '(210 0.0 0.0 1.0)))
  122.      (princ "\nHatch not in WCS!")
  123.   )
  124.   (setq xv (cdr (assoc 210 ed1)))
  125.   (command "._ucs" "_w")
  126.   (setq loops1 (cdr (assoc 91 ed1)))
  127.          ; number of boundary paths (loops)
  128.   (if (and A2k (= (strcase (cdr (assoc 410 ed1))) "MODEL"))
  129.      (setq space *ModelSpace*)
  130.      (setq space *PaperSpace*)
  131.   )
  132.   (repeat loops1
  133.      (setq ed1 (member (assoc 92 ed1) ed1))
  134.      (setq bptf (cdr (car ed1))) ; boundary path type flag
  135.      (setq ic (cdr (assoc 73 ed1))) ; is closed
  136.      (setq noe (cdr (assoc 93 ed1))) ; number of edges
  137.      (setq bot (cdr (assoc 92 ed1))) ; boundary type
  138.      (setq hst (cdr (assoc 75 ed1))) ; hatch style
  139.      (setq ed1 (member (assoc 72 ed1) ed1))
  140.      (setq bul (cdr (car ed1))) ; bulge
  141.      (setq plist nil)
  142.      (setq blist nil)
  143.      (cond
  144.          ((> (boole 1 bptf 2) 0) ; polyline
  145.            (repeat noe
  146.                (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
  147.                (setq plist (append plist (list (cdr (assoc 10 ed1)))))
  148.                (setq blist (append blist
  149.              (if (> bul 0)
  150.                  (list (cdr (assoc 42 ed1)))
  151.                  nil
  152.              )
  153.            )
  154.                )
  155.            )
  156.            (if A2k
  157.                (progn
  158.      (setq polypoints
  159.      (apply 'append
  160.                    (mapcar '3dPoint->2dPoint plist)
  161.      )
  162.      )
  163.      (setq VLADataPts (list->variantArray polypoints))
  164.      (setq
  165.          obj (vla-addLightweightPolyline space VLADataPts)
  166.      )
  167.      (setq nr 0)
  168.      (repeat (length blist)
  169.          (if (/= (nth nr blist) 0)
  170.              (vla-setBulge obj nr (nth nr blist))
  171.          )
  172.          (setq nr (1+ nr))
  173.      )
  174.      (if (= ic 1)
  175.          (vla-put-closed obj T)
  176.      )
  177.                )
  178.                (progn
  179.      (if (= ic 1)
  180.          (entmake '((0 . "POLYLINE") (66 . 1) (70 . 1)))
  181.          (entmake '((0 . "POLYLINE") (66 . 1)))
  182.      )
  183.      (setq nr 0)
  184.      (repeat (length plist)
  185.          (if (= bul 0)
  186.              (entmake (list (cons 0 "VERTEX")
  187.                (cons 10 (nth nr plist))
  188.                  )
  189.              )
  190.              (entmake (list (cons 0 "VERTEX")
  191.                (cons 10 (nth nr plist))
  192.                (cons 42 (nth nr blist))
  193.                  )
  194.              )
  195.          )
  196.          (setq nr (1+ nr))
  197.      )
  198.      (entmake '((0 . "SEQEND")))
  199.                )
  200.            )
  201.          )
  202.          (t       ; not polyline
  203.            (setq lastent (entlast))
  204.            (setq lwp T)
  205.            (repeat noe
  206.                (setq et (cdr (assoc 72 ed1)))
  207.                (cond
  208.      ((= et 1)   ; line
  209.        (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
  210.        (if A2k
  211.            (vla-AddLine
  212.                space
  213.                (vlax-3d-point (cdr (assoc 10 ed1)))
  214.                (vlax-3d-point (cdr (assoc 11 ed1)))
  215.            )
  216.            (entmake
  217.                (list
  218.      (cons 0 "LINE")
  219.      (list 10
  220.                  (cadr (assoc 10 ed1))
  221.                  (caddr (assoc 10 ed1))
  222.                  0
  223.      )
  224.      (list 11
  225.                  (cadr (assoc 11 ed1))
  226.                  (caddr (assoc 11 ed1))
  227.                  0
  228.      )
  229.          ;   (cons 210 xv)
  230.                )
  231.            )
  232.        )
  233.        (setq ed1 (cddr ed1))
  234.      )
  235.      ((= et 2)   ; circular arc
  236.        (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
  237.        (setq ang1 (cdr (assoc 50 ed1)))
  238.        (setq ang2 (cdr (assoc 51 ed1)))
  239.        (setq cw (cdr (assoc 73 ed1)))
  240.        (if (equal ang2 6.28319 0.00001)
  241.            (progn
  242.                (if A2k
  243.      (vla-AddCircle
  244.          space
  245.          (vlax-3d-point (cdr (assoc 10 ed1)))
  246.          (cdr (assoc 40 ed1))
  247.      )
  248.      (entmake (list (cons 0 "CIRCLE")
  249.                      (assoc 10 ed1)
  250.                      (assoc 40 ed1)
  251.          )
  252.      )
  253.                )
  254.                (setq lwp nil)
  255.            )
  256.            (if A2k
  257.                (vla-AddArc
  258.      space
  259.      (vlax-3d-point (cdr (assoc 10 ed1)))
  260.      (cdr (assoc 40 ed1))
  261.      (if (= cw 0)
  262.          (- 0 ang2)
  263.          ang1
  264.      )
  265.      (if (= cw 0)
  266.          (- 0 ang1)
  267.          ang2
  268.      )
  269.                )
  270.                (entmake (list (cons 0 "ARC")
  271.                  (assoc 10 ed1)
  272.                  (assoc 40 ed1)
  273.                  (cons 50
  274.                (if (= cw 0)
  275.                    (- 0 ang2)
  276.                    ang1
  277.                )
  278.                  )
  279.                  (cons 51
  280.                (if (= cw 0)
  281.                    (- 0 ang1)
  282.                    ang2
  283.                )
  284.                  )
  285.                    )
  286.                )
  287.            )
  288.        )
  289.        (setq ed1 (cddddr ed1))
  290.      )
  291.      ((= et 3)   ; elliptic arc
  292.        (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
  293.        (setq ang1 (cdr (assoc 50 ed1)))
  294.        (setq ang2 (cdr (assoc 51 ed1)))
  295.        (setq cw (cdr (assoc 73 ed1)))
  296.        (if A2k
  297.            (progn
  298.                (setq obj (vla-AddEllipse
  299.            space
  300.            (vlax-3d-point (cdr (assoc 10 ed1)))
  301.            (vlax-3d-point (cdr (assoc 11 ed1)))
  302.            (cdr (assoc 40 ed1))
  303.        )
  304.                )
  305.                (vla-put-startangle
  306.      obj
  307.      (if (= cw 0)
  308.          (- 0 ang2)
  309.          ang1
  310.      )
  311.                )
  312.                (vla-put-endangle
  313.      obj
  314.      (if (= cw 0)
  315.          (- 0 ang1)
  316.          ang2
  317.      )
  318.                )
  319.            )
  320.            (princ "\nElliptic arc not supported!")
  321.        )
  322.        (setq lwp nil)
  323.      )
  324.      ((= et 4)   ; spline
  325.        (setq ed1 (member (assoc 94 (cdr ed1)) ed1))
  326.        (setq knot-list nil)
  327.        (setq controlpoint-list nil)
  328.        (setq kn (cdr (assoc 95 ed1)))
  329.        (setq cn (cdr (assoc 96 ed1)))
  330.        (setq pos (vl-position (assoc 40 ed1) ed1))
  331.        (repeat kn
  332.            (setq
  333.                knot-list (cons (cons 40 (cdr (nth pos ed1)))
  334.                    knot-list
  335.        )
  336.            )
  337.            (setq pos (1+ pos))
  338.        )
  339.        (setq pos (vl-position (assoc 10 ed1) ed1))
  340.        (repeat cn
  341.            (setq controlpoint-list
  342.            (cons
  343.                (cons 10 (cdr (nth pos ed1)))
  344.                controlpoint-list
  345.            )
  346.            )
  347.            (setq pos (1+ pos))
  348.        )
  349.        (setq knot-list (reverse knot-list))
  350.        (setq controlpoint-list (reverse controlpoint-list))
  351.        (entmake (append
  352.                (list '(0 . "SPLINE"))
  353.                (list (cons 100 "AcDbEntity"))
  354.                (list (cons 100 "AcDbSpline"))
  355.                (list (cons 70
  356.            (+ 1
  357.                  8
  358.                  (* 2 (cdr (assoc 74 ed1)))
  359.                  (* 4 (cdr (assoc 73 ed1)))
  360.            )
  361.              )
  362.                )
  363.                (list (cons 71 (cdr (assoc 94 ed1))))
  364.                (list (cons 72 kn))
  365.                (list (cons 73 cn))
  366.                knot-list
  367.                controlpoint-list
  368.            )
  369.        )
  370.        (setq ed1 (member (assoc 10 ed1) ed1))
  371.        (setq lwp nil)
  372.      )
  373.                )     ; end cond
  374.            )       ; end repeat noe
  375.            (if lwp
  376.                (progn
  377.      (setq en1 (entnext lastent))
  378.      (setq ss (ssadd))
  379.      (ssadd en1 ss)
  380.      (while (setq en2 (entnext en1))
  381.          (ssadd en2 ss)
  382.          (setq en1 en2)
  383.      )
  384.      (if (= (getvar "peditaccept") 1)
  385.          (command "_.pedit" (entlast) "_J" ss "" "")
  386.          (command "_.pedit" (entlast) "_Y" "_J" ss "" "")
  387.      )
  388.                )
  389.            )
  390.          )       ; end t
  391.      )       ; end cond
  392.          ; Tries to get the area on islands but it's not clear how to know if an island is filled or not
  393.          ; and if it should be substracted or added to the total area.
  394.          ; (if (or (= bot 0) (= (boole 1 bot 1) 1)) (setq area (+ area (areaOfObject (entlast)))))
  395.          ; (if (and (/= hst 1) (/= bot 0) (= (boole 1 bot 1) 0)) (setq area (- area (areaOfObject (entlast)))))
  396.          ; (princ "\n") (princ bot) (princ "\n") (princ hst) (princ "\n")
  397.          ; (princ (areaOfObject (entlast)))
  398.   )       ; end repeat loops1
  399.   (if (= loops1 1)
  400.      (setq area (+ area (areaOfObject (entlast))))
  401.      (setq bMoreLoops T)
  402.   )
  403.   (setq i (1+ i))
  404.            )
  405.        )
  406.    )
  407.    (if (and area (not bMoreLoops))
  408.        (progn
  409.            (princ "\nTotal Area = ")
  410.            (princ area)
  411.        )
  412.    )
  413.    (restore)
  414.    (princ)
  415. )
发表于 2007-4-26 13:21:00 | 显示全部楼层

急求各位高手,能不能像AutoCAD 2006中BHATCH命令一样,不既可以重建填充边界,而且重建后的填充边界线能够与原来的填充图案实现关联!!!!???

非常感谢!!!

发表于 2007-4-28 19:46:00 | 显示全部楼层
请龙龙仔帮忙
发表于 2007-4-29 15:29:00 | 显示全部楼层

里面用到一个MH的命令,不知道是不是LZ希望的效果

 

本帖子中包含更多资源

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

x
发表于 2007-4-29 15:47:00 | 显示全部楼层

ljpnb ,你在说什么,我怎么看不懂?!

发表于 2007-4-30 05:41:00 | 显示全部楼层
不知道楼上的有没有注意到1楼要求是"如何提取出剖面线的填充边界及其属性",我的MH命令(modify hatch缩写)的目的是自动提取剖面线的属性,并且自动获取新的需要填充的边界
发表于 2011-7-13 11:54:26 | 显示全部楼层
楼上只有贴图,未见源码啊,寻找中。。。
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-17 17:33 , Processed in 0.205338 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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