Community
AutoCAD Map 3D Developer
Welcome to Autodesk’s AutoCAD Map 3D Developer Forums. Share your knowledge, ask questions, and explore popular AutoCAD Map 3D Developer topics.
Turn on suggestions
Auto-suggest helps you quickly narrow down your search results by suggesting possible matches as you type.
This page has been translated for your convenience with an automatic translation service. This is not an official translation and may contain errors and inaccurate translations. Autodesk does not warrant, either expressly or implied, the accuracy, reliability or completeness of the information translated by the machine translation service and will not be liable for damages or losses caused by the trust placed in the translation service.
Translate
automatically create the bound (polyline or polygon) of an hatch
3 REPLIES 3
Reply
Topic Options
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page
Message 1 of 4
Anonymous
261 Views, 3 Replies
06-22-2003
11:50 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
06-22-2003
11:50 PM
automatically create the bound (polyline or polygon) of an hatch
I've got the hatches but I've not got the polylines bordering the hatches.
Is it possible to automatically create the bound (polyline or polygon) of an
hatch ?
Thanks in advance
Paolo
Is it possible to automatically create the bound (polyline or polygon) of an
hatch ?
Thanks in advance
Paolo
3 REPLIES 3
Message 2 of 4
Anonymous
in reply to:
Anonymous
06-23-2003
03:47 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
06-23-2003
03:47 PM
Not with Map but there is a free lisp routine around on the interent to do
just that. Sorry don't know its name but shouldn't take long to find.
"Paolo" wrote in message
news:D8BF089C260F77DC700F97D584057D46@in.WebX.maYIadrTaRb...
> I've got the hatches but I've not got the polylines bordering the hatches.
> Is it possible to automatically create the bound (polyline or polygon) of
an
> hatch ?
> Thanks in advance
> Paolo
>
>
just that. Sorry don't know its name but shouldn't take long to find.
"Paolo"
news:D8BF089C260F77DC700F97D584057D46@in.WebX.maYIadrTaRb...
> I've got the hatches but I've not got the polylines bordering the hatches.
> Is it possible to automatically create the bound (polyline or polygon) of
an
> hatch ?
> Thanks in advance
> Paolo
>
>
Message 3 of 4
Anonymous
in reply to:
Anonymous
06-24-2003
12:36 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
06-24-2003
12:36 AM
try this
;;; HATCHB.LSP
;;; Recreates hatch boundary by selecting a hatch
;;; Boundary is created in current layer/color/linetype in WCS
;;; By Jimmy B
;;; e-mail: cadman@yesbox.net
;;; 2000-02-12 - First release
;;; 2000-03-27 - Counterclockwise arc's and ellipse's fixed
;;; Objects created joined to lwpolyline if possible
;;; Error-handling, undo of command
;;; Can handle PLINETYPE = 0,1,2
;;; 2000-03-30 - Integrating hatchb and hatchb14
;;; Selection of many hatches
;;; Splines supported if closed.
;;; Tested on AutoCAD 2000
;;; should be working on older versions too.
(defun c:hb () (c:hatchb)) ; this line can be commented out if there is an
existing command called hb
(defun c:hatchb (/ es blay ed1 ed2 loops1 bptf part
et noe plist ic bul nr ang1 ang2 obj
*ModelSpace* *PaperSpace*
space cw errexit undox olderr oldcmdecho ss1 lastent en1 en2 ss
lwp
list->variantArray 3dPoint->2dPoint A2k ent i ss2
knot-list controlpoint-list kn cn pos
)
(setq A2k (wcmatch (getvar "ACADVER") "15*"))
(if A2k
(defun list->variantArray (ptsList / arraySpace sArray)
(setq arraySpace
(vlax-make-safearray
vlax-vbdouble
(cons 0 (- (length ptsList) 1))
)
)
(setq sArray (vlax-safearray-fill arraySpace ptsList))
(vlax-make-variant sArray)
)
)
(if A2k
(defun 3dPoint->2dPoint (3dpt)
(list (float (car 3dpt)) (float (cadr 3dpt)))
)
)
(defun errexit (s)
(princ "\nError: ")
(princ s)
(restore)
)
(defun undox ()
(command "._ucs" "_p")
(command "._undo" "_E")
(setvar "cmdecho" oldcmdecho)
(setq *error* olderr)
(princ)
)
(setq olderr *error*
restore undox
*error* errexit
)
(setq oldcmdecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "._UNDO" "_BE")
(if A2k (progn
(vl-load-com)
(setq *ModelSpace* (vla-get-ModelSpace
(vla-get-ActiveDocument (vlax-get-acad-object))
)
*PaperSpace* (vla-get-PaperSpace
(vla-get-ActiveDocument (vlax-get-acad-object))
)
))
)
(if (/= (setq ss2 (ssget '((0 . "HATCH")))) nil)
(progn
(setq i 0)
(while (setq ent (ssname ss2 i))
(setq ed1 (entget ent))
(if (not (equal (assoc 210 ed1) '(210 0.0 0.0 1.0))) (princ "\nHatch
not in WCS!"))
(command "._ucs" "_w")
(setq loops1 (cdr (assoc 91 ed1))) ; number of boundary paths (loops)
(if (and A2k (= (strcase (cdr (assoc 410 ed1))) "MODEL"))
(setq space *ModelSpace*)
(setq space *PaperSpace*)
)
(repeat loops1
(setq ed1 (member (assoc 92 ed1) ed1))
(setq bptf (cdr (car ed1))) ; boundary path type flag
(setq ic (cdr (assoc 73 ed1))) ; is closed
(setq noe (cdr (assoc 93 ed1))) ; number of edges
(setq ed1 (member (assoc 72 ed1) ed1))
(setq bul (cdr (car ed1))) ; bulge
(setq plist nil)
(setq blist nil)
(cond
((> (boole 1 bptf 2) 0) ; polyline
(repeat noe
(setq ed1 (member (assoc 10 (cdr ed1)) ed1))
(setq plist (append plist (list (cdr (assoc 10 ed1)))))
(setq blist (append blist
(if (> bul 0)
(list (cdr (assoc 42 ed1)))
nil
)
)
)
)
(if A2k (progn
(setq polypoints
(apply 'append
(mapcar '3dPoint->2dPoint plist)
)
)
(setq VLADataPts (list->variantArray polypoints))
(setq obj (vla-addLightweightPolyline space VLADataPts))
(setq nr 0)
(repeat (length blist)
(if (/= (nth nr blist) 0)
(vla-setBulge obj nr (nth nr blist))
)
(setq nr (1+ nr))
)
(if (= ic 1)
(vla-put-closed obj T)
)
)
(progn
(if (= ic 1)
(entmake '((0 . "POLYLINE") (66 . 1) (70 . 1)))
(entmake '((0 . "POLYLINE") (66 . 1)))
)
(setq nr 0)
(repeat (length plist)
(if (= bul 0)
(entmake (list (cons 0 "VERTEX")
(cons 10 (nth nr plist))
)
)
(entmake (list (cons 0 "VERTEX")
(cons 10 (nth nr plist))
(cons 42 (nth nr blist))
)
)
)
(setq nr (1+ nr))
)
(entmake '((0 . "SEQEND")))
)
)
)
(t ; not polyline
(setq lastent (entlast))
(setq lwp T)
(repeat noe
(setq et (cdr (assoc 72 ed1)))
(cond
((= et 1) ; line
(setq ed1 (member (assoc 10 (cdr ed1)) ed1))
(if A2k
(vla-AddLine
space
(vlax-3d-point (cdr (assoc 10 ed1)))
(vlax-3d-point (cdr (assoc 11 ed1)))
)
(entmake
(list (cons 0 "LINE") (assoc 10 ed1) (assoc 11 ed1))
)
)
(setq ed1 (cddr ed1))
)
((= et 2) ; circular arc
(setq ed1 (member (assoc 10 (cdr ed1)) ed1))
(setq ang1 (cdr (assoc 50 ed1)))
(setq ang2 (cdr (assoc 51 ed1)))
(setq cw (cdr (assoc 73 ed1)))
(if (equal ang2 6.28319 0.00001)
(progn
(if A2k
(vla-AddCircle
space
(vlax-3d-point (cdr (assoc 10 ed1)))
(cdr (assoc 40 ed1))
)
(entmake (list (cons 0 "CIRCLE")
(assoc 10 ed1)
(assoc 40 ed1)
)
)
)
(setq lwp nil)
)
(if A2k
(vla-AddArc
space
(vlax-3d-point (cdr (assoc 10 ed1)))
(cdr (assoc 40 ed1))
(if (= cw 0)
(- 0 ang2)
ang1
)
(if (= cw 0)
(- 0 ang1)
ang2
)
)
(entmake (list (cons 0 "ARC")
(assoc 10 ed1)
(assoc 40 ed1)
(cons 50
(if (= cw 0)
(- 0 ang2)
ang1
)
)
(cons 51
(if (= cw 0)
(- 0 ang1)
ang2
)
)
)
)
)
)
(setq ed1 (cddddr ed1))
)
((= et 3) ; elliptic arc
(setq ed1 (member (assoc 10 (cdr ed1)) ed1))
(setq ang1 (cdr (assoc 50 ed1)))
(setq ang2 (cdr (assoc 51 ed1)))
(setq cw (cdr (assoc 73 ed1)))
(if A2k (progn
(setq obj (vla-AddEllipse
space
(vlax-3d-point (cdr (assoc 10 ed1)))
(vlax-3d-point (cdr (assoc 11 ed1)))
(cdr (assoc 40 ed1))
)
)
(vla-put-startangle obj (if (= cw 0) (- 0 ang2) ang1))
(vla-put-endangle obj (if (= cw 0) (- 0 ang1) ang2))
)
(princ "\nElliptic arc not supported!")
)
(setq lwp nil)
)
((= et 4) ; spline
(setq ed1 (member (assoc 94 (cdr ed1)) ed1))
(setq knot-list nil)
(setq controlpoint-list nil)
(setq kn (cdr (assoc 95 ed1)))
(setq cn (cdr (assoc 96 ed1)))
(setq pos (vl-position (assoc 40 ed1) ed1))
(repeat kn
(setq knot-list (cons (cons 40 (cdr (nth pos ed1)))
knot-list))
(setq pos (1+ pos))
)
(setq pos (vl-position (assoc 10 ed1) ed1))
(repeat cn
(setq controlpoint-list (cons (cons 10 (cdr (nth pos
ed1))) controlpoint-list))
(setq pos (1+ pos))
)
(setq knot-list (reverse knot-list))
(setq controlpoint-list (reverse controlpoint-list))
(entmake (append
(list '(0 . "SPLINE"))
(list (cons 100 "AcDbEntity"))
(list (cons 100 "AcDbSpline"))
(list (cons 70 (+ 1 8 (* 2 (cdr (assoc 74
ed1))) (* 4 (cdr (assoc 73 ed1))))))
(list (cons 71 (cdr (assoc 94 ed1))))
(list (cons 72 kn))
(list (cons 73 cn))
knot-list
controlpoint-list
)
)
(setq ed1 (member (assoc 10 ed1) ed1))
(setq lwp nil)
)
) ; end cond
) ; end repeat noe
(if lwp (progn
(setq en1 (entnext lastent))
(setq ss (ssadd))
(ssadd en1 ss)
(while (setq en2 (entnext en1))
(ssadd en2 ss)
(setq en1 en2)
)
(command "_.pedit" (entlast) "_Y" "_J" ss "" "")
))
) ; end t
) ; end cond
) ; end repeat loops1
(setq i (1+ i))
)
)
)
(restore)
(princ)
)
;;; HATCHB.LSP
;;; Recreates hatch boundary by selecting a hatch
;;; Boundary is created in current layer/color/linetype in WCS
;;; By Jimmy B
;;; e-mail: cadman@yesbox.net
;;; 2000-02-12 - First release
;;; 2000-03-27 - Counterclockwise arc's and ellipse's fixed
;;; Objects created joined to lwpolyline if possible
;;; Error-handling, undo of command
;;; Can handle PLINETYPE = 0,1,2
;;; 2000-03-30 - Integrating hatchb and hatchb14
;;; Selection of many hatches
;;; Splines supported if closed.
;;; Tested on AutoCAD 2000
;;; should be working on older versions too.
(defun c:hb () (c:hatchb)) ; this line can be commented out if there is an
existing command called hb
(defun c:hatchb (/ es blay ed1 ed2 loops1 bptf part
et noe plist ic bul nr ang1 ang2 obj
*ModelSpace* *PaperSpace*
space cw errexit undox olderr oldcmdecho ss1 lastent en1 en2 ss
lwp
list->variantArray 3dPoint->2dPoint A2k ent i ss2
knot-list controlpoint-list kn cn pos
)
(setq A2k (wcmatch (getvar "ACADVER") "15*"))
(if A2k
(defun list->variantArray (ptsList / arraySpace sArray)
(setq arraySpace
(vlax-make-safearray
vlax-vbdouble
(cons 0 (- (length ptsList) 1))
)
)
(setq sArray (vlax-safearray-fill arraySpace ptsList))
(vlax-make-variant sArray)
)
)
(if A2k
(defun 3dPoint->2dPoint (3dpt)
(list (float (car 3dpt)) (float (cadr 3dpt)))
)
)
(defun errexit (s)
(princ "\nError: ")
(princ s)
(restore)
)
(defun undox ()
(command "._ucs" "_p")
(command "._undo" "_E")
(setvar "cmdecho" oldcmdecho)
(setq *error* olderr)
(princ)
)
(setq olderr *error*
restore undox
*error* errexit
)
(setq oldcmdecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "._UNDO" "_BE")
(if A2k (progn
(vl-load-com)
(setq *ModelSpace* (vla-get-ModelSpace
(vla-get-ActiveDocument (vlax-get-acad-object))
)
*PaperSpace* (vla-get-PaperSpace
(vla-get-ActiveDocument (vlax-get-acad-object))
)
))
)
(if (/= (setq ss2 (ssget '((0 . "HATCH")))) nil)
(progn
(setq i 0)
(while (setq ent (ssname ss2 i))
(setq ed1 (entget ent))
(if (not (equal (assoc 210 ed1) '(210 0.0 0.0 1.0))) (princ "\nHatch
not in WCS!"))
(command "._ucs" "_w")
(setq loops1 (cdr (assoc 91 ed1))) ; number of boundary paths (loops)
(if (and A2k (= (strcase (cdr (assoc 410 ed1))) "MODEL"))
(setq space *ModelSpace*)
(setq space *PaperSpace*)
)
(repeat loops1
(setq ed1 (member (assoc 92 ed1) ed1))
(setq bptf (cdr (car ed1))) ; boundary path type flag
(setq ic (cdr (assoc 73 ed1))) ; is closed
(setq noe (cdr (assoc 93 ed1))) ; number of edges
(setq ed1 (member (assoc 72 ed1) ed1))
(setq bul (cdr (car ed1))) ; bulge
(setq plist nil)
(setq blist nil)
(cond
((> (boole 1 bptf 2) 0) ; polyline
(repeat noe
(setq ed1 (member (assoc 10 (cdr ed1)) ed1))
(setq plist (append plist (list (cdr (assoc 10 ed1)))))
(setq blist (append blist
(if (> bul 0)
(list (cdr (assoc 42 ed1)))
nil
)
)
)
)
(if A2k (progn
(setq polypoints
(apply 'append
(mapcar '3dPoint->2dPoint plist)
)
)
(setq VLADataPts (list->variantArray polypoints))
(setq obj (vla-addLightweightPolyline space VLADataPts))
(setq nr 0)
(repeat (length blist)
(if (/= (nth nr blist) 0)
(vla-setBulge obj nr (nth nr blist))
)
(setq nr (1+ nr))
)
(if (= ic 1)
(vla-put-closed obj T)
)
)
(progn
(if (= ic 1)
(entmake '((0 . "POLYLINE") (66 . 1) (70 . 1)))
(entmake '((0 . "POLYLINE") (66 . 1)))
)
(setq nr 0)
(repeat (length plist)
(if (= bul 0)
(entmake (list (cons 0 "VERTEX")
(cons 10 (nth nr plist))
)
)
(entmake (list (cons 0 "VERTEX")
(cons 10 (nth nr plist))
(cons 42 (nth nr blist))
)
)
)
(setq nr (1+ nr))
)
(entmake '((0 . "SEQEND")))
)
)
)
(t ; not polyline
(setq lastent (entlast))
(setq lwp T)
(repeat noe
(setq et (cdr (assoc 72 ed1)))
(cond
((= et 1) ; line
(setq ed1 (member (assoc 10 (cdr ed1)) ed1))
(if A2k
(vla-AddLine
space
(vlax-3d-point (cdr (assoc 10 ed1)))
(vlax-3d-point (cdr (assoc 11 ed1)))
)
(entmake
(list (cons 0 "LINE") (assoc 10 ed1) (assoc 11 ed1))
)
)
(setq ed1 (cddr ed1))
)
((= et 2) ; circular arc
(setq ed1 (member (assoc 10 (cdr ed1)) ed1))
(setq ang1 (cdr (assoc 50 ed1)))
(setq ang2 (cdr (assoc 51 ed1)))
(setq cw (cdr (assoc 73 ed1)))
(if (equal ang2 6.28319 0.00001)
(progn
(if A2k
(vla-AddCircle
space
(vlax-3d-point (cdr (assoc 10 ed1)))
(cdr (assoc 40 ed1))
)
(entmake (list (cons 0 "CIRCLE")
(assoc 10 ed1)
(assoc 40 ed1)
)
)
)
(setq lwp nil)
)
(if A2k
(vla-AddArc
space
(vlax-3d-point (cdr (assoc 10 ed1)))
(cdr (assoc 40 ed1))
(if (= cw 0)
(- 0 ang2)
ang1
)
(if (= cw 0)
(- 0 ang1)
ang2
)
)
(entmake (list (cons 0 "ARC")
(assoc 10 ed1)
(assoc 40 ed1)
(cons 50
(if (= cw 0)
(- 0 ang2)
ang1
)
)
(cons 51
(if (= cw 0)
(- 0 ang1)
ang2
)
)
)
)
)
)
(setq ed1 (cddddr ed1))
)
((= et 3) ; elliptic arc
(setq ed1 (member (assoc 10 (cdr ed1)) ed1))
(setq ang1 (cdr (assoc 50 ed1)))
(setq ang2 (cdr (assoc 51 ed1)))
(setq cw (cdr (assoc 73 ed1)))
(if A2k (progn
(setq obj (vla-AddEllipse
space
(vlax-3d-point (cdr (assoc 10 ed1)))
(vlax-3d-point (cdr (assoc 11 ed1)))
(cdr (assoc 40 ed1))
)
)
(vla-put-startangle obj (if (= cw 0) (- 0 ang2) ang1))
(vla-put-endangle obj (if (= cw 0) (- 0 ang1) ang2))
)
(princ "\nElliptic arc not supported!")
)
(setq lwp nil)
)
((= et 4) ; spline
(setq ed1 (member (assoc 94 (cdr ed1)) ed1))
(setq knot-list nil)
(setq controlpoint-list nil)
(setq kn (cdr (assoc 95 ed1)))
(setq cn (cdr (assoc 96 ed1)))
(setq pos (vl-position (assoc 40 ed1) ed1))
(repeat kn
(setq knot-list (cons (cons 40 (cdr (nth pos ed1)))
knot-list))
(setq pos (1+ pos))
)
(setq pos (vl-position (assoc 10 ed1) ed1))
(repeat cn
(setq controlpoint-list (cons (cons 10 (cdr (nth pos
ed1))) controlpoint-list))
(setq pos (1+ pos))
)
(setq knot-list (reverse knot-list))
(setq controlpoint-list (reverse controlpoint-list))
(entmake (append
(list '(0 . "SPLINE"))
(list (cons 100 "AcDbEntity"))
(list (cons 100 "AcDbSpline"))
(list (cons 70 (+ 1 8 (* 2 (cdr (assoc 74
ed1))) (* 4 (cdr (assoc 73 ed1))))))
(list (cons 71 (cdr (assoc 94 ed1))))
(list (cons 72 kn))
(list (cons 73 cn))
knot-list
controlpoint-list
)
)
(setq ed1 (member (assoc 10 ed1) ed1))
(setq lwp nil)
)
) ; end cond
) ; end repeat noe
(if lwp (progn
(setq en1 (entnext lastent))
(setq ss (ssadd))
(ssadd en1 ss)
(while (setq en2 (entnext en1))
(ssadd en2 ss)
(setq en1 en2)
)
(command "_.pedit" (entlast) "_Y" "_J" ss "" "")
))
) ; end t
) ; end cond
) ; end repeat loops1
(setq i (1+ i))
)
)
)
(restore)
(princ)
)
Message 4 of 4
Anonymous
in reply to:
Anonymous
06-24-2003
06:21 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
06-24-2003
06:21 PM
I've not got words to thank you!
That's just what I needed and it works greatly!
Thank you very much!
Paolo
"Mike O'Brien" ha scritto nel messaggio
news:A933E61EF4E7A0E081E691951C2A19E9@in.WebX.maYIadrTaRb...
> try this
> ;;; HATCHB.LSP
> ;;; Recreates hatch boundary by selecting a hatch
> ;;; Boundary is created in current layer/color/linetype in WCS
> ;;; By Jimmy B
> ;;; e-mail: cadman@yesbox.net
> ;;; 2000-02-12 - First release
> ;;; 2000-03-27 - Counterclockwise arc's and ellipse's fixed
> ;;; Objects created joined to lwpolyline if possible
> ;;; Error-handling, undo of command
> ;;; Can handle PLINETYPE = 0,1,2
> ;;; 2000-03-30 - Integrating hatchb and hatchb14
> ;;; Selection of many hatches
> ;;; Splines supported if closed.
> ;;; Tested on AutoCAD 2000
> ;;; should be working on older versions too.
>
> (defun c:hb () (c:hatchb)) ; this line can be commented out if there is an
> existing command called hb
> (defun c:hatchb (/ es blay ed1 ed2 loops1 bptf part
> et noe plist ic bul nr ang1 ang2 obj
> *ModelSpace* *PaperSpace*
> space cw errexit undox olderr oldcmdecho ss1 lastent en1 en2
ss
> lwp
> list->variantArray 3dPoint->2dPoint A2k ent i ss2
> knot-list controlpoint-list kn cn pos
> )
> (setq A2k (wcmatch (getvar "ACADVER") "15*"))
> (if A2k
> (defun list->variantArray (ptsList / arraySpace sArray)
> (setq arraySpace
> (vlax-make-safearray
> vlax-vbdouble
> (cons 0 (- (length ptsList) 1))
> )
> )
> (setq sArray (vlax-safearray-fill arraySpace ptsList))
> (vlax-make-variant sArray)
> )
> )
> (if A2k
> (defun 3dPoint->2dPoint (3dpt)
> (list (float (car 3dpt)) (float (cadr 3dpt)))
> )
> )
>
> (defun errexit (s)
> (princ "\nError: ")
> (princ s)
> (restore)
> )
>
> (defun undox ()
> (command "._ucs" "_p")
> (command "._undo" "_E")
> (setvar "cmdecho" oldcmdecho)
> (setq *error* olderr)
> (princ)
> )
>
> (setq olderr *error*
> restore undox
> *error* errexit
> )
> (setq oldcmdecho (getvar "cmdecho"))
> (setvar "cmdecho" 0)
> (command "._UNDO" "_BE")
> (if A2k (progn
> (vl-load-com)
> (setq *ModelSpace* (vla-get-ModelSpace
> (vla-get-ActiveDocument (vlax-get-acad-object))
> )
> *PaperSpace* (vla-get-PaperSpace
> (vla-get-ActiveDocument (vlax-get-acad-object))
> )
> ))
> )
> (if (/= (setq ss2 (ssget '((0 . "HATCH")))) nil)
> (progn
> (setq i 0)
> (while (setq ent (ssname ss2 i))
> (setq ed1 (entget ent))
> (if (not (equal (assoc 210 ed1) '(210 0.0 0.0 1.0))) (princ "\nHatch
> not in WCS!"))
> (command "._ucs" "_w")
> (setq loops1 (cdr (assoc 91 ed1))) ; number of boundary paths
(loops)
> (if (and A2k (= (strcase (cdr (assoc 410 ed1))) "MODEL"))
> (setq space *ModelSpace*)
> (setq space *PaperSpace*)
> )
> (repeat loops1
> (setq ed1 (member (assoc 92 ed1) ed1))
> (setq bptf (cdr (car ed1))) ; boundary path type flag
> (setq ic (cdr (assoc 73 ed1))) ; is closed
> (setq noe (cdr (assoc 93 ed1))) ; number of edges
> (setq ed1 (member (assoc 72 ed1) ed1))
> (setq bul (cdr (car ed1))) ; bulge
> (setq plist nil)
> (setq blist nil)
> (cond
> ((> (boole 1 bptf 2) 0) ; polyline
> (repeat noe
> (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
> (setq plist (append plist (list (cdr (assoc 10 ed1)))))
> (setq blist (append blist
> (if (> bul 0)
> (list (cdr (assoc 42 ed1)))
> nil
> )
> )
> )
> )
> (if A2k (progn
> (setq polypoints
> (apply 'append
> (mapcar '3dPoint->2dPoint plist)
> )
> )
> (setq VLADataPts (list->variantArray polypoints))
> (setq obj (vla-addLightweightPolyline space VLADataPts))
> (setq nr 0)
> (repeat (length blist)
> (if (/= (nth nr blist) 0)
> (vla-setBulge obj nr (nth nr blist))
> )
> (setq nr (1+ nr))
> )
> (if (= ic 1)
> (vla-put-closed obj T)
> )
> )
> (progn
> (if (= ic 1)
> (entmake '((0 . "POLYLINE") (66 . 1) (70 . 1)))
> (entmake '((0 . "POLYLINE") (66 . 1)))
> )
> (setq nr 0)
> (repeat (length plist)
> (if (= bul 0)
> (entmake (list (cons 0 "VERTEX")
> (cons 10 (nth nr plist))
> )
> )
> (entmake (list (cons 0 "VERTEX")
> (cons 10 (nth nr plist))
> (cons 42 (nth nr blist))
> )
> )
> )
> (setq nr (1+ nr))
> )
> (entmake '((0 . "SEQEND")))
> )
> )
> )
> (t ; not polyline
> (setq lastent (entlast))
> (setq lwp T)
> (repeat noe
> (setq et (cdr (assoc 72 ed1)))
> (cond
> ((= et 1) ; line
> (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
> (if A2k
> (vla-AddLine
> space
> (vlax-3d-point (cdr (assoc 10 ed1)))
> (vlax-3d-point (cdr (assoc 11 ed1)))
> )
> (entmake
> (list (cons 0 "LINE") (assoc 10 ed1) (assoc 11 ed1))
> )
> )
> (setq ed1 (cddr ed1))
> )
> ((= et 2) ; circular arc
> (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
> (setq ang1 (cdr (assoc 50 ed1)))
> (setq ang2 (cdr (assoc 51 ed1)))
> (setq cw (cdr (assoc 73 ed1)))
> (if (equal ang2 6.28319 0.00001)
> (progn
> (if A2k
> (vla-AddCircle
> space
> (vlax-3d-point (cdr (assoc 10 ed1)))
> (cdr (assoc 40 ed1))
> )
> (entmake (list (cons 0 "CIRCLE")
> (assoc 10 ed1)
> (assoc 40 ed1)
> )
> )
> )
> (setq lwp nil)
> )
> (if A2k
> (vla-AddArc
> space
> (vlax-3d-point (cdr (assoc 10 ed1)))
> (cdr (assoc 40 ed1))
> (if (= cw 0)
> (- 0 ang2)
> ang1
> )
> (if (= cw 0)
> (- 0 ang1)
> ang2
> )
> )
> (entmake (list (cons 0 "ARC")
> (assoc 10 ed1)
> (assoc 40 ed1)
> (cons 50
> (if (= cw 0)
> (- 0 ang2)
> ang1
> )
> )
> (cons 51
> (if (= cw 0)
> (- 0 ang1)
> ang2
> )
> )
> )
> )
> )
> )
> (setq ed1 (cddddr ed1))
> )
> ((= et 3) ; elliptic arc
> (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
> (setq ang1 (cdr (assoc 50 ed1)))
> (setq ang2 (cdr (assoc 51 ed1)))
> (setq cw (cdr (assoc 73 ed1)))
> (if A2k (progn
> (setq obj (vla-AddEllipse
> space
> (vlax-3d-point (cdr (assoc 10 ed1)))
> (vlax-3d-point (cdr (assoc 11 ed1)))
> (cdr (assoc 40 ed1))
> )
> )
> (vla-put-startangle obj (if (= cw 0) (- 0 ang2) ang1))
> (vla-put-endangle obj (if (= cw 0) (- 0 ang1) ang2))
> )
> (princ "\nElliptic arc not supported!")
> )
> (setq lwp nil)
> )
> ((= et 4) ; spline
> (setq ed1 (member (assoc 94 (cdr ed1)) ed1))
> (setq knot-list nil)
> (setq controlpoint-list nil)
> (setq kn (cdr (assoc 95 ed1)))
> (setq cn (cdr (assoc 96 ed1)))
> (setq pos (vl-position (assoc 40 ed1) ed1))
> (repeat kn
> (setq knot-list (cons (cons 40 (cdr (nth pos ed1)))
> knot-list))
> (setq pos (1+ pos))
> )
> (setq pos (vl-position (assoc 10 ed1) ed1))
> (repeat cn
> (setq controlpoint-list (cons (cons 10 (cdr (nth pos
> ed1))) controlpoint-list))
> (setq pos (1+ pos))
> )
> (setq knot-list (reverse knot-list))
> (setq controlpoint-list (reverse controlpoint-list))
> (entmake (append
> (list '(0 . "SPLINE"))
> (list (cons 100 "AcDbEntity"))
> (list (cons 100 "AcDbSpline"))
> (list (cons 70 (+ 1 8 (* 2 (cdr (assoc 74
> ed1))) (* 4 (cdr (assoc 73 ed1))))))
> (list (cons 71 (cdr (assoc 94 ed1))))
> (list (cons 72 kn))
> (list (cons 73 cn))
> knot-list
> controlpoint-list
> )
> )
> (setq ed1 (member (assoc 10 ed1) ed1))
> (setq lwp nil)
> )
> ) ; end cond
> ) ; end repeat noe
> (if lwp (progn
> (setq en1 (entnext lastent))
> (setq ss (ssadd))
> (ssadd en1 ss)
> (while (setq en2 (entnext en1))
> (ssadd en2 ss)
> (setq en1 en2)
> )
> (command "_.pedit" (entlast) "_Y" "_J" ss "" "")
> ))
> ) ; end t
> ) ; end cond
> ) ; end repeat loops1
> (setq i (1+ i))
> )
> )
> )
> (restore)
> (princ)
> )
>
>
That's just what I needed and it works greatly!
Thank you very much!
Paolo
"Mike O'Brien"
news:A933E61EF4E7A0E081E691951C2A19E9@in.WebX.maYIadrTaRb...
> try this
> ;;; HATCHB.LSP
> ;;; Recreates hatch boundary by selecting a hatch
> ;;; Boundary is created in current layer/color/linetype in WCS
> ;;; By Jimmy B
> ;;; e-mail: cadman@yesbox.net
> ;;; 2000-02-12 - First release
> ;;; 2000-03-27 - Counterclockwise arc's and ellipse's fixed
> ;;; Objects created joined to lwpolyline if possible
> ;;; Error-handling, undo of command
> ;;; Can handle PLINETYPE = 0,1,2
> ;;; 2000-03-30 - Integrating hatchb and hatchb14
> ;;; Selection of many hatches
> ;;; Splines supported if closed.
> ;;; Tested on AutoCAD 2000
> ;;; should be working on older versions too.
>
> (defun c:hb () (c:hatchb)) ; this line can be commented out if there is an
> existing command called hb
> (defun c:hatchb (/ es blay ed1 ed2 loops1 bptf part
> et noe plist ic bul nr ang1 ang2 obj
> *ModelSpace* *PaperSpace*
> space cw errexit undox olderr oldcmdecho ss1 lastent en1 en2
ss
> lwp
> list->variantArray 3dPoint->2dPoint A2k ent i ss2
> knot-list controlpoint-list kn cn pos
> )
> (setq A2k (wcmatch (getvar "ACADVER") "15*"))
> (if A2k
> (defun list->variantArray (ptsList / arraySpace sArray)
> (setq arraySpace
> (vlax-make-safearray
> vlax-vbdouble
> (cons 0 (- (length ptsList) 1))
> )
> )
> (setq sArray (vlax-safearray-fill arraySpace ptsList))
> (vlax-make-variant sArray)
> )
> )
> (if A2k
> (defun 3dPoint->2dPoint (3dpt)
> (list (float (car 3dpt)) (float (cadr 3dpt)))
> )
> )
>
> (defun errexit (s)
> (princ "\nError: ")
> (princ s)
> (restore)
> )
>
> (defun undox ()
> (command "._ucs" "_p")
> (command "._undo" "_E")
> (setvar "cmdecho" oldcmdecho)
> (setq *error* olderr)
> (princ)
> )
>
> (setq olderr *error*
> restore undox
> *error* errexit
> )
> (setq oldcmdecho (getvar "cmdecho"))
> (setvar "cmdecho" 0)
> (command "._UNDO" "_BE")
> (if A2k (progn
> (vl-load-com)
> (setq *ModelSpace* (vla-get-ModelSpace
> (vla-get-ActiveDocument (vlax-get-acad-object))
> )
> *PaperSpace* (vla-get-PaperSpace
> (vla-get-ActiveDocument (vlax-get-acad-object))
> )
> ))
> )
> (if (/= (setq ss2 (ssget '((0 . "HATCH")))) nil)
> (progn
> (setq i 0)
> (while (setq ent (ssname ss2 i))
> (setq ed1 (entget ent))
> (if (not (equal (assoc 210 ed1) '(210 0.0 0.0 1.0))) (princ "\nHatch
> not in WCS!"))
> (command "._ucs" "_w")
> (setq loops1 (cdr (assoc 91 ed1))) ; number of boundary paths
(loops)
> (if (and A2k (= (strcase (cdr (assoc 410 ed1))) "MODEL"))
> (setq space *ModelSpace*)
> (setq space *PaperSpace*)
> )
> (repeat loops1
> (setq ed1 (member (assoc 92 ed1) ed1))
> (setq bptf (cdr (car ed1))) ; boundary path type flag
> (setq ic (cdr (assoc 73 ed1))) ; is closed
> (setq noe (cdr (assoc 93 ed1))) ; number of edges
> (setq ed1 (member (assoc 72 ed1) ed1))
> (setq bul (cdr (car ed1))) ; bulge
> (setq plist nil)
> (setq blist nil)
> (cond
> ((> (boole 1 bptf 2) 0) ; polyline
> (repeat noe
> (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
> (setq plist (append plist (list (cdr (assoc 10 ed1)))))
> (setq blist (append blist
> (if (> bul 0)
> (list (cdr (assoc 42 ed1)))
> nil
> )
> )
> )
> )
> (if A2k (progn
> (setq polypoints
> (apply 'append
> (mapcar '3dPoint->2dPoint plist)
> )
> )
> (setq VLADataPts (list->variantArray polypoints))
> (setq obj (vla-addLightweightPolyline space VLADataPts))
> (setq nr 0)
> (repeat (length blist)
> (if (/= (nth nr blist) 0)
> (vla-setBulge obj nr (nth nr blist))
> )
> (setq nr (1+ nr))
> )
> (if (= ic 1)
> (vla-put-closed obj T)
> )
> )
> (progn
> (if (= ic 1)
> (entmake '((0 . "POLYLINE") (66 . 1) (70 . 1)))
> (entmake '((0 . "POLYLINE") (66 . 1)))
> )
> (setq nr 0)
> (repeat (length plist)
> (if (= bul 0)
> (entmake (list (cons 0 "VERTEX")
> (cons 10 (nth nr plist))
> )
> )
> (entmake (list (cons 0 "VERTEX")
> (cons 10 (nth nr plist))
> (cons 42 (nth nr blist))
> )
> )
> )
> (setq nr (1+ nr))
> )
> (entmake '((0 . "SEQEND")))
> )
> )
> )
> (t ; not polyline
> (setq lastent (entlast))
> (setq lwp T)
> (repeat noe
> (setq et (cdr (assoc 72 ed1)))
> (cond
> ((= et 1) ; line
> (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
> (if A2k
> (vla-AddLine
> space
> (vlax-3d-point (cdr (assoc 10 ed1)))
> (vlax-3d-point (cdr (assoc 11 ed1)))
> )
> (entmake
> (list (cons 0 "LINE") (assoc 10 ed1) (assoc 11 ed1))
> )
> )
> (setq ed1 (cddr ed1))
> )
> ((= et 2) ; circular arc
> (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
> (setq ang1 (cdr (assoc 50 ed1)))
> (setq ang2 (cdr (assoc 51 ed1)))
> (setq cw (cdr (assoc 73 ed1)))
> (if (equal ang2 6.28319 0.00001)
> (progn
> (if A2k
> (vla-AddCircle
> space
> (vlax-3d-point (cdr (assoc 10 ed1)))
> (cdr (assoc 40 ed1))
> )
> (entmake (list (cons 0 "CIRCLE")
> (assoc 10 ed1)
> (assoc 40 ed1)
> )
> )
> )
> (setq lwp nil)
> )
> (if A2k
> (vla-AddArc
> space
> (vlax-3d-point (cdr (assoc 10 ed1)))
> (cdr (assoc 40 ed1))
> (if (= cw 0)
> (- 0 ang2)
> ang1
> )
> (if (= cw 0)
> (- 0 ang1)
> ang2
> )
> )
> (entmake (list (cons 0 "ARC")
> (assoc 10 ed1)
> (assoc 40 ed1)
> (cons 50
> (if (= cw 0)
> (- 0 ang2)
> ang1
> )
> )
> (cons 51
> (if (= cw 0)
> (- 0 ang1)
> ang2
> )
> )
> )
> )
> )
> )
> (setq ed1 (cddddr ed1))
> )
> ((= et 3) ; elliptic arc
> (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
> (setq ang1 (cdr (assoc 50 ed1)))
> (setq ang2 (cdr (assoc 51 ed1)))
> (setq cw (cdr (assoc 73 ed1)))
> (if A2k (progn
> (setq obj (vla-AddEllipse
> space
> (vlax-3d-point (cdr (assoc 10 ed1)))
> (vlax-3d-point (cdr (assoc 11 ed1)))
> (cdr (assoc 40 ed1))
> )
> )
> (vla-put-startangle obj (if (= cw 0) (- 0 ang2) ang1))
> (vla-put-endangle obj (if (= cw 0) (- 0 ang1) ang2))
> )
> (princ "\nElliptic arc not supported!")
> )
> (setq lwp nil)
> )
> ((= et 4) ; spline
> (setq ed1 (member (assoc 94 (cdr ed1)) ed1))
> (setq knot-list nil)
> (setq controlpoint-list nil)
> (setq kn (cdr (assoc 95 ed1)))
> (setq cn (cdr (assoc 96 ed1)))
> (setq pos (vl-position (assoc 40 ed1) ed1))
> (repeat kn
> (setq knot-list (cons (cons 40 (cdr (nth pos ed1)))
> knot-list))
> (setq pos (1+ pos))
> )
> (setq pos (vl-position (assoc 10 ed1) ed1))
> (repeat cn
> (setq controlpoint-list (cons (cons 10 (cdr (nth pos
> ed1))) controlpoint-list))
> (setq pos (1+ pos))
> )
> (setq knot-list (reverse knot-list))
> (setq controlpoint-list (reverse controlpoint-list))
> (entmake (append
> (list '(0 . "SPLINE"))
> (list (cons 100 "AcDbEntity"))
> (list (cons 100 "AcDbSpline"))
> (list (cons 70 (+ 1 8 (* 2 (cdr (assoc 74
> ed1))) (* 4 (cdr (assoc 73 ed1))))))
> (list (cons 71 (cdr (assoc 94 ed1))))
> (list (cons 72 kn))
> (list (cons 73 cn))
> knot-list
> controlpoint-list
> )
> )
> (setq ed1 (member (assoc 10 ed1) ed1))
> (setq lwp nil)
> )
> ) ; end cond
> ) ; end repeat noe
> (if lwp (progn
> (setq en1 (entnext lastent))
> (setq ss (ssadd))
> (ssadd en1 ss)
> (while (setq en2 (entnext en1))
> (ssadd en2 ss)
> (setq en1 en2)
> )
> (command "_.pedit" (entlast) "_Y" "_J" ss "" "")
> ))
> ) ; end t
> ) ; end cond
> ) ; end repeat loops1
> (setq i (1+ i))
> )
> )
> )
> (restore)
> (princ)
> )
>
>
Reply
Topic Options
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page
![Autodesk Design & Make Report](https://forums.autodesk.com/t5/image/serverpage/image-id/1350519iCB55845EBFC43016/image-size/large?v=v2&px=999" "Autodesk Design & Make Report")
