Lisp to trim a simple hatch

[xtyux]

Good day!

 

I'm making a routine

 

1. Input Rectangle Size >> DONE

2. Insert custom hatch >> DONE

3. Trim out boundaries to make hatch pattern a 4 sided polyon (as seen on pic) >> need help

4. PEDIT >> I can manage this

5. EXTRUDE >> I can manage this

 

I need help in number 3. The rectangle varies and so is my hatch. But basically it usually is in that images attached.

 

 

Is it possible? Thank you

[marko_ribar]

Firstly EXPLODE HATCH and ASSOCIATIVE BOUNDARY...

Then,

Do these procedures explained here :

http://forums.augi.com/showthread.php?168170-Need-Lisp-for-Trim-at-junctions&p=#2

 

After complex REGION is created, EXPLODE it and use JOIN command to convert outlines to LWPOLYLINES, or PEDIT as you wish (Multiple->Join) options...

 

HTH.,M.R.

[xtyux]

thanks marko but i only have autocad 2007. i was looking at those apps and total boundary pro seems to have an instant work on these but it isn't supported with autocad 2007 according to their site. i'll look more into it.

[BIGAL]

I did something similar being honest never really finished it but it drew parallel lines within any shape rather than a hatch, it did not join the ends as it it used extrim to clip lines larger than the shape.

 

; chevron island creater
; this use the extrim command to trim shape
; By Alan H Jan 2012
(defun C:Chevron ( / obj pt1 pt2 pt3 pt4 newpt1 newpt2 )

(setq obj (car (entsel "\nPick pline or circle")))
; should do a object test here
(setq whatis (cdr (assoc 0 (entget obj))))
(if (= whatis "LWPOLYLINE")
(princ)
(progn
(princ "\You have picked something other than a polyline ")
(princ "\Remake into a pline and do again ")
(setq dummy (getstring "\press any key"))
(exit)
) ; progn
) ; if
(alert "draw a line at angle \nmake sure it is full over shape")
(setq pt1 (Getpoint "\nPick Line start point"))
(setq pt2 (Getpoint pt1 "\nPick end point"))
(command "line" pt1 pt2 "") ; 

(setq gap1 (getreal "\nenter spacing 1"))
(setq gap2 (getreal "\nenter spacing 2"))

(setq pt3 (getpoint "\nPick 1st cross point"))
(setq pt4 (getpoint pt3 "\nPick 2nd cross point"))
(setq dist (distance pt3 pt4))
(setq x (fix (/ dist (+ gap1 gap2))))

(setq newpt1 (strcat (rtos gap1 2 2) ",0.0"))
(setq newpt2 (strcat (rtos gap2 2 2) ",0.0"))

(repeat x 
(command "copy" "L" "" "0,0" newpt1)
(command "copy" "L" "" "0,0" newpt2)
)

(load "Extrim")
(etrim obj pt1)

) ; end defun


(princ)

[xtyux]

The code below is from Lee Mac. I saw it from another site. Is that okay if I posted it here? Credits to Lee Mac.

 

(defun c:brkAll (/ *error* doc spc ss Objlst Obj iLst Altlst lst)
 (vl-load-com)

 (defun *error* (msg)
   (if doc (vla-EndUndoMark doc))
   (if ov (mapcar 'setvar vl ov))
   (if (not
         (wcmatch
           (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))
     (princ
       (strcat "\n** Error: " msg " **")))
   (princ))

 (setq doc (vla-get-ActiveDocument
             (vlax-get-Acad-Object))
       spc (if (zerop (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))
 
 (setq vl '("CMDECHO" "OSMODE")
       ov (mapcar 'getvar vl))
 
 (vla-StartUndoMark doc)
 (or *brk$dis* (setq *brk$dis* 5.))
 (if (setq ss (ssget '((0 . "*LINE,ARC"))))
   (progn
     (or (not
           (setq tmp
             (getdist
               (strcat "\nSpecify Break Distance <" (rtos *brk$dis* 2 2) "> : "))))
         (setq *brk$dis* tmp))
     (setq Objlst
       (mapcar 'vlax-ename->vla-object
         (vl-remove-if 'listp
           (mapcar 'cadr (ssnamex ss)))))
     (while (setq Obj (car Objlst))
       (foreach iObj (setq Objlst (cdr Objlst))
         (setq iLst
           (cons
             (cons Obj
               (vlax-list->3D-point
                 (vlax-invoke Obj
                   'IntersectWith iObj acExtendNone))) iLst))))
     (mapcar 'setvar vl '(0 0))
     (foreach Int (vl-remove-if-not
                    (function
                      (lambda (x)
                        (vl-consp (cdr x)))) iLst)
       (setq Obj (car Int))
       (foreach Pt (cdr Int)
         (and Altlst (setq lst Altlst))
         (if (not (setq bDis (vlax-curve-getDistatPoint Obj Pt)))
           (while (and (not bDis) lst)
             (setq bDis (vlax-curve-getDistatPoint (setq Obj (car lst)) Pt)
                   lst (cdr lst))))
         (if bDis
           (progn
             (or (setq bPt1 (vlax-curve-getPointatDist Obj
                              (+ bDis (/ *brk$dis* 2.))))
                 (setq bPt1 (vlax-curve-getEndPoint Obj)))
             (or (setq bPt2 (vlax-curve-getPointatDist Obj
                              (- bDis (/ *brk$dis* 2.))))
                 (setq bPt2 (vlax-curve-getStartPoint Obj)))
             (command "_.Break"
               (list (vlax-vla-object->ename Obj) pt) "_F" bPt1 bPt2)
             (setq AltLst (cons (vlax-ename->vla-object (entlast)) AltLst)))))))
   (princ "\n** Nothing Selected **"))
 (vla-EndUndoMark doc)
 (mapcar 'setvar vl ov)
 (princ))
             

(defun vlax-list->3D-point (lst)
 (if lst
   (cons (list (car lst) (cadr lst) (caddr lst))
         (vlax-list->3D-point (cdddr lst)))))

 

What I did is I modified his code to break all intersecting lines.

My problem now is how do I select all Lines with a specific layer and not longer than let's say 1" or 1 unit. I'm kinda new to autolisp. I only look codes online and modify trial and error but I don't know how to filter Lines by layers and lengths.

 

(ssget "_X" '((0 . "LINE")))

or this also worked

(ssget "_X" '((8 . "layername"))) but I need to specify condition about the specific length.

 

If anyone can help, thank you

[xtyux]

Thanks I will look into this.