如何得到图元的最大外形?
<p></p><p> 请问各位大侠我选择左边所示的图元(可能为多段线,也可能为单个的简单图元),通过VBA如何得到如右图红线所示的所有图元的最大外形?</p> sieben发表于2008-7-21 9:38:00static/image/common/back.gif42636 1,获取全部实体选择集，要求外围是封闭的 2,获取选择集的矩形绿色轮廓，使用getboundingbox函数可以实现 3,将绿色轮廓再向外偏移一定距离得到黄色轮廓 4,取一绿色黄色轮廓间的点，使用Bo<p>通过选择集,对选择集再进行GetBoundingBox</p> linheyuanpcb 发表于 2008-10-19 09:57
感谢分享，可用！ 好用精准{:1_1:} <p>1、遍历判断</p><p>2、做成块或者是组合成多段线用getbound来获得</p> <p>lz的意思非常难以实现。</p><p>getboundingbox 只是一个矩形区域的坐标点。</p> 本帖最后由 作者 于 2008-7-21 9:47:02 编辑
1,获取全部实体选择集，要求外围是封闭的 2,获取选择集的矩形绿色轮廓，使用getboundingbox函数可以实现 3,将绿色轮廓再向外偏移一定距离得到黄色轮廓 4,取一绿色黄色轮廓间的点，使用Boundary命令可以得到5两个紫色轮廓 5,干掉第5步中外面的轮廓，即可得到第6轮廓 通过面积能判断吗？ 谢谢楼上各位的回复,特别是<strong><font face="Verdana" color="#61b713">sieben的详细解答!</font></strong> <p>有代码吗？可以给我留个不·谢谢</p> ;;;包裹描边
; getArea subRoutine
(defun getArea ( entName / )
(command "_.AREA" "O" entName)
(setq objArea (getvar "AREA"))
) ;defun
(defun c:wq(/ oldEcho objsToWrap extMin extMax minX minY maxX maxY
diagDist boxOffset boxLL boxLR boxUR boxUL
boundPoint boxObj newObjs lastEntName entName
newObjsLen maxArea counter thisArea wrapOption
)
(setq oldEcho (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(prompt "\nWrap Objects (w/Polyline(s)):")
;|
Swap commenting with (setq) line below...
If you want ELLIPSE and SPLINE objects to be selectable
|;
;(setq objsToWrap (ssget))
(setq objsToWrap
(ssget '(
(-4 . "<NOT")
(-4 . "<OR")
(0 . "ELLIPSE")
(0 . "SPLINE")
(-4 . "OR>")
(-4 . "NOT>"))
) ;ssget
) ;setq
(if (/= objsToWrap nil)
(progn
(command "_.UNDO" "BEGIN")
(setq wrapOption "Single") ;default to single
(initget "Single Multiple")
(prompt "\nWrap Options:")
(prompt "\n Single: Only the largest outer profile will be created.")
(prompt "\n Multiple: Nested, or detatched profiles will also be created.")
(setq wrapOption (getkword "\nWrap option <Single>: "))
(if (= wrapOption "Multiple")
(setq wrapOption "Multiple")
(setq wrapOption "Single")
) ;if
; Create bounding box, larger than existing drawing...
(setq extMin (getvar "EXTMIN"))
(setq extMax (getvar "EXTMAX"))
(setq minX (car extMin))
(setq minY (cadr extMin))
(setq maxX (car extMax))
(setq maxY (cadr extMax))
(setq diagDist (distance extMin extMax))
(setq boxOffset (* diagDist 0.1))
(setq boxLL (list (- minX boxOffset) (- minY boxOffset) 0))
(setq boxLR (list (+ maxX boxOffset) (- minY boxOffset) 0))
(setq boxUR (list (+ maxX boxOffset) (+ maxY boxOffset) 0))
(setq boxUL (list (- minX boxOffset) (+ maxY boxOffset) 0))
(setq boundPoint (list (- minX (/ boxOffset 2)) (- minY (/ boxOffset 2)) 0))
(command "_.PLINE" boxLL boxLR boxUR boxUL "C")
(setq boxObj (entlast))
(command "_.-BOUNDARY" "A" "O" "P" "I" "Y" "B" "N" boxObj objsToWrap "" "" boundPoint "")
; Get a list of the entities created by the boundary command...
(setq lastEntName boxObj)
(while (setq entName (entnext lastEntName))
(setq newObjs (append newObjs (list entName)))
(setq lastEntName entName)
) ;while
;Get the greatest object area, of the new objects (the duplicate polyline, of our temp box)
(setq newObjsLen (length newObjs))
(setq maxArea 0)
(setq counter 0)
(while (< counter newObjsLen)
(setq thisArea (getArea (nth counter newObjs)))
(if (>= thisArea maxArea)
(setq maxArea thisArea)
) ;if
(setq counter (1+ counter))
) ;while
; Delete the Object, that matches the maxArea (the duplicate polyline)
(setq counter 0)
(while (< counter newObjsLen)
(setq thisArea (getArea (nth counter newObjs)))
(if (= thisArea maxArea)
(progn
(entdel (nth counter newObjs))
(setq counter newObjsLen) ;break loop
) ;progn
) ;if
(setq counter (1+ counter))
) ;while
(if (= wrapOption "Single")
(progn
; Get the REMAINING new objects...
(setq newObjs nil)
(setq lastEntName boxObj)
(while (setq entName (entnext lastEntName))
(setq newObjs (append newObjs (list entName)))
(setq lastEntName entName)
) ;while
; Get the NEXT greatest object area, of the REMAINING new objects (this is the one we want to keep!)
(setq newObjsLen (length newObjs))
(setq maxArea 0)
(setq counter 0)
(while (< counter newObjsLen)
(setq thisArea (getArea (nth counter newObjs)))
(if (>= thisArea maxArea)
(setq maxArea thisArea)
) ;if
(setq counter (1+ counter))
) ;while
; Delete the Object, UNLESS it matches the maxArea (the one we want to keep!)...
(setq counter 0)
(while (< counter newObjsLen)
(setq thisArea (getArea (nth counter newObjs)))
(if (/= thisArea maxArea)
(progn
(entdel (nth counter newObjs))
) ;progn
) ;if
(setq counter (1+ counter))
) ;while
) ;progn
) ;if
;Erase the original box...
(command "_.ERASE" boxObj "")
(command "_.UNDO" "END")
) ;progn
) ;if
(setvar "CMDECHO" oldEcho)
(princ)
) ;defun
;(prompt "\nWrapObjects.lsp...Loaded!")
(prompt "\nPCB模具设计:a 外形-0.075单边 内槽+0.075单 1.6T IF 1.0T 0.05单边 线路+绿油+正字符+阻焊+反字符+碳油 先想清楚再下手做,磨刀不误砍柴工! ")
(princ)
谢谢，真是个好东西，貌似不怎么看的懂，慢慢研究中···
页:
[1]
2