;; By ElpanovEvgeniy
;; 03.04.2007 10:03:51:
(defun entmakex-hatch (L)
(entmakex
(apply
'append
(list
(list '(0 . "HATCH")
'(100 . "AcDbEntity")
'(410 . "Model")
'(100 . "AcDbHatch")
'(10 0.0 0.0 0.0)
'(210 0.0 0.0 1.0)
'(2 . "SOLID")
'(70 . 1)
'(71 . 0)
(cons 91 (length l))
) ;_ list
(apply 'append
(mapcar '(lambda (a)
(apply 'append
(list (list '(92 . 7) '(72 . 0) '(73 . 1) (cons 93 (length a)))
(mapcar '(lambda (b) (cons 10 b)) a)
'((97 . 0))
) ;_ list
) ;_ apply
) ;_ lambda
l
) ;_ mapcar
)
'((75 . 0)
(76 . 1)
(47 . 1.)
(98 . 2)
(10 0. 0. 0.0)
(10 0. 0. 0.0)
(451 . 0)
(460 . 0.0)
(461 . 0.0)
(452 . 1)
(462 . 1.0)
(453 . 2)
(463 . 0.0)
(463 . 1.0)
(470 . "LINEAR")
)
) ;_ list
) ;_ apply
) ;_ entmakex
); _
1)I would like to do that only with ssget plines on layer 1 and layer 2. ;; Batch BPoly - Lee Mac
;; Generates polylines for every region formed by a selection of lines & polylines
;; Restricted to LWPolylines with linear segments only.
;; Region generation based on a method by Stefan M.
;; Mod by M.R. to add ability for hatching resulting LWPOLYLINES
;; By ElpanovEvgeniy
;; 03.04.2007 10:03:51:
(defun entmakex-hatch (L)
(entmakex
(apply
'append
(list
(list '(0 . "HATCH")
'(100 . "AcDbEntity")
'(410 . "Model")
'(100 . "AcDbHatch")
'(10 0.0 0.0 0.0)
'(210 0.0 0.0 1.0)
'(2 . "SOLID")
'(70 . 1)
'(71 . 0)
'(91 . 1)
) ;_ list
(apply 'append
(list (list '(92 . 7) '(72 . 0) '(73 . 1) (cons 93 (length L)))
(mapcar '(lambda (b) (cons 10 b)) L)
'((97 . 0))
) ;_ list
) ;_ apply
'((75 . 0)
(76 . 1)
(47 . 1.)
(98 . 2)
(10 0. 0. 0.0)
(10 0. 0. 0.0)
(451 . 0)
(460 . 0.0)
(461 . 0.0)
(452 . 1)
(462 . 1.0)
(453 . 2)
(463 . 0.0)
(463 . 1.0)
(470 . "LINEAR")
)
) ;_ list
) ;_ apply
) ;_ entmakex
); _
(defun c:bbpoly&hatch ( / *error* big ent enx idx int lst pt1 pt2 rtn sel spc tmp tot val var vtx entl )
(defun *error* ( msg )
(foreach obj rtn
(if (and (vlax-write-enabled-p obj) (not (vlax-erased-p obj)))
(vla-delete obj)
)
)
(mapcar 'setvar var val)
(LM:endundo (LM:acdoc))
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(LM:startundo (LM:acdoc))
(cond
( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (getvar 'clayer))))))
(princ "\nCurrent layer locked.")
)
( (setq sel
(LM:ssget "\nSelect Lines & Polylines: "
(list
(list
'(-4 . "<OR")
'(0 . "LINE")
'(-4 . "<AND")
'(0 . "LWPOLYLINE")
'(-4 . "<NOT")
'(-4 . "<>")
'(42 . 0.0)
'(-4 . "NOT>")
'(-4 . "AND>")
'(-4 . "OR>")
(if (= 1 (getvar 'cvport))
(cons 410 (getvar 'ctab))
'(410 . "Model")
)
)
)
)
)
(setq spc
(vlax-get-property (LM:acdoc)
(if (= 1 (getvar 'cvport))
'paperspace
'modelspace
)
)
)
(repeat (setq idx (sslength sel))
(if (= "LINE" (cdr (assoc 0 (setq enx (entget (ssname sel (setq idx (1- idx))))))))
(setq lst (cons (list (cdr (assoc 10 enx)) (cdr (assoc 11 enx))) lst))
(setq vtx (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) enx))
vtx (mapcar 'list vtx (if (= 1 (logand 1 (cdr (assoc 70 enx)))) (cons (last vtx) vtx) (cdr vtx)))
lst (append vtx lst)
)
)
)
(foreach pl1 lst
(setq pt1 (car pl1)
pt2 (cadr pl1)
)
(foreach pl2 lst
(if
(and
(not (equal pl1 pl2 1e-8))
(setq int (inters pt1 pt2 (car pl2) (cadr pl2)))
(not (vl-member-if '(lambda ( pnt ) (equal pnt int 1e-8)) pl1))
)
(setq pl1 (cons int pl1))
)
)
(setq rtn
(append
(mapcar
(function
(lambda ( a b )
(vla-addline spc
(vlax-3D-point a)
(vlax-3D-point b)
)
)
)
(setq pl1
(vl-sort pl1
(function
(lambda ( a b )
(< (distance pt1 a) (distance pt1 b))
)
)
)
)
(cdr pl1)
)
rtn
)
)
)
(setq var '(cmdecho peditaccept)
val (mapcar 'getvar var)
tot 0.0
)
(mapcar 'setvar var '(0 1))
(foreach reg (vlax-invoke spc 'addregion rtn)
(setq ent (entlast))
(command "_.pedit" "_m")
(apply 'command (mapcar 'vlax-vla-object->ename (vlax-invoke reg 'explode)))
(command "" "_j" "" "")
(if
(and
(not (eq ent (setq ent (entlast))))
(= "LWPOLYLINE" (cdr (assoc 0 (entget ent))))
)
(progn
(setq tmp (vlax-curve-getarea ent)
tot (+ tot tmp)
entl (cons ent entl)
)
(if (< (car big) tmp)
(setq big (list tmp ent))
)
)
)
(vla-delete reg)
)
(if (equal (car big) (/ tot 2.0) 1e-3) ;; Gian Paolo Cattaneo
(entdel (cadr big))
)
(foreach obj rtn (vla-delete obj))
(mapcar 'setvar var val)
)
)
(foreach ent entl
(if (not (vlax-erased-p ent))
(progn
(entmakex-hatch (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget ent))))
(entdel ent)
(command "_.DRAWORDER" "_L" "" "_B")
)
)
)
(LM:endundo (LM:acdoc))
(princ)
)
;; ssget - Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments
(defun LM:ssget ( msg arg / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget arg))
(setvar 'nomutt 0)
(if (not (vl-catch-all-error-p sel)) sel)
)
;; Start Undo - Lee Mac
;; Opens an Undo Group.
(defun LM:startundo ( doc )
(LM:endundo doc)
(vla-startundomark doc)
)
;; End Undo - Lee Mac
;; Closes an Undo Group.
(defun LM:endundo ( doc )
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)
;; Active Document - Lee Mac
;; Returns the VLA Active Document Object
(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)
(vl-load-com) (princ)
Evgeniy's code isn't quite appropriate for the task...Maybe this:
Then I've found that small gap that had to be connectedMy question is, how to connect these plines not manualy but in my lisp tests2p.
Then I've found that small gap that had to be connectedMy question is, how to connect these plines not manualy but in my lisp tests2p.
(
(<Nazwa elementu: 7ffff9132c0> <Nazwa elementu: 7ffff913200> <Nazwa elementu: 7ffff9132b0>)
(<Nazwa elementu: 7ffff9132b0> <Nazwa elementu: 7ffff913200> <Nazwa elementu: 7ffff913200>)
(<Nazwa elementu: 7ffff9132a0> <Nazwa elementu: 7ffff913200> <Nazwa elementu: 7ffff913290>)
(<Nazwa elementu: 7ffff913290> <Nazwa elementu: 7ffff913200> <Nazwa elementu: 7ffff913250>)
(<Nazwa elementu: 7ffff913250> <Nazwa elementu: 7ffff913200> <Nazwa elementu: 7ffff913200>)
(<Nazwa elementu: 7ffff913200> <Nazwa elementu: 7ffff9132a0> <Nazwa elementu: 7ffff913250>)
)
Where first element of sublist is entity of pline to extend, second is entity to which should be extended start point of pline to extend and third element is entity of pline to which should be extended end point of pline to extend.