Jump to content

hatch building lisp - help

Guest

By Guest
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Guest

Guest

Posted
Posted

Hi i am using this code to hatch buildings. I need  some changes

 

1) All the timew the offset = 0.50

2) hatch pattern =Line

3) hatch scale  =0.125

4) harch angle = 50 grads

 

I upload my template  units

  

(defun C:HB ( / *error* Doc vars vals ans od e ent etyp Obj1 p Obj2 start end coords)
  
  (gc)
  (vl-load-com)
  (COMMAND "_layer" "_m" "HATCH" "_c" "171" "" "_lw" "0.15" "" "")
  (or *acad* (setq *acad* (vlax-get-acad-object)))
  (setq Doc     (vla-get-ActiveDocument *acad*))
  (setq vars '("cmdecho"))
  (setq vals (mapcar 'getvar vars))
  (defun *error* (Error)
    (mapcar 'setvar vars vals)
    (if e (redraw e 4))
    (vla-endundomark Doc)
    (cond
      ((not Error))
      ((wcmatch (strcase Error) "*QUIT*,*CANCEL*")
        ;(vl-exit-with-error "\r                                              ")
      )
      (1
        (princ (strcat "\n*ERROR*: " Error))
        ;(vl-exit-with-error (strcat "\r*ERROR*: " Error))
      )
    )
    (princ)
  )
  (vla-endundomark Doc)
  (vla-startundomark Doc)
  (mapcar 'setvar vars '(0))
  (command "_.EXPERT" (getvar "EXPERT"))
  (defun @2d (p)(list (car p)(cadr p)))
  (and
    (setq od (getvar "offsetdist"))
    (not (initget 4))
    (if (setq ans (getdist (strcat "\nOffset distance <" (rtos od) ">: ")))
      (setvar "offsetdist" (setq od ans))
      1
    )
    (or (entmake) 1)
    (setvar "errno" 0)
    (while (/= (getvar "errno") 52)
      (if e (redraw e 4))
      (and
        (setq e (car (entsel "Select object to offset: ")))
        (setq Obj1 (vlax-ename->vla-object e))
        (setq ent (entget e))
        (setq etyp (cdr (assoc 0 ent)))
        (or
          (= etyp "LWPOLYLINE")
          (prompt (strcat "\nObject selected is a(n) " etyp "."))
        )
        (setq closed (vlax-get obj1 'closed))
        (or (redraw e 3) 1)
        (setq p (getpoint "\nSide to offset: "))
        (vl-cmdf "_.offset" od e p "")
        (setq obj2 (vlax-ename->vla-object (entlast)))
        (if (= closed 0)
          (progn
            (setq start (@2d (vlax-curve-getstartpoint Obj1)))
            (setq end (@2d (vlax-curve-getendpoint Obj1)))
            (setq coords (vlax-get Obj2 'Coordinates))
            (vlax-put Obj2 'Coordinates (append start coords end))
            1
          )
          1
        )
        (vl-cmdf "_.-hatch" "_S" (ssadd (vlax-vla-object->ename Obj1) (ssadd (vlax-vla-object->ename Obj2))) "" "")
        (vla-delete Obj2)
      )
    )
  )
  (*error* nil)
 (SETVAR "OSMODE" OS)
 (command "linetype" "s" "bylayer" "") 
 (command "setvar" "clayer" "0")
)

 

Thanks

 

units1.jpg

units2.jpg

confutatis Enthusiast

confutatis

Posted
Posted 
(defun C:HB2 ( / *error* Doc vars vals ans od e ent etyp Obj1 p Obj2 start end coords)
  (gc)
  (vl-load-com)
  (setq os (getvar "OSMODE"))
  (vl-cmdf "_layer" "_m" "HATCH" "_c" "171" "" "_lw" "0.15" "" "")
  (or *acad* (setq *acad* (vlax-get-acad-object)))
  (setq Doc     (vla-get-ActiveDocument *acad*))
  (setq vars '("cmdecho"))
  (setq vals (mapcar 'getvar vars))
  (defun *error* (Error)
    (mapcar 'setvar vars vals)
    (if e (redraw e 4))
    (vla-endundomark Doc)
    (cond
      ((not Error))
      ((wcmatch (strcase Error) "*QUIT*,*CANCEL*")
        ;(vl-exit-with-error "\r                                              ")
      )
      (1
        (princ (strcat "\n*ERROR*: " Error))
        ;(vl-exit-with-error (strcat "\r*ERROR*: " Error))
      )
    )
    (princ)
  )
  (vla-endundomark Doc)
  (vla-startundomark Doc)
  (mapcar 'setvar vars '(0))
  (command "_.EXPERT" (getvar "EXPERT"))
 
  (defun @2d (p)(list (car p)(cadr p)))
 
  (and
    (setq od 0.50)
;;;    (not (initget 4))
;;;    (if (setq ans (getdist (strcat "\nOffset distance <" (rtos od) ">: ")))
;;;      (setvar "offsetdist" (setq od ans))
;;;      1
;;;    )
    (or (entmake) 1)
    (setvar "errno" 0)
    (while (/= (getvar "errno") 52)
      (if e (redraw e 4))
      (and
        (setq e (car (entsel "Select object to offset: ")))
        (setq Obj1 (vlax-ename->vla-object e))
        (setq ent (entget e))
        (setq etyp (cdr (assoc 0 ent)))
        (or
          (= etyp "LWPOLYLINE")
          (prompt (strcat "\nObject selected is a(n) " etyp "."))
        )
        (setq closed (vlax-get obj1 'closed))
        (or (redraw e 3) 1)
        (setq p (getpoint "\nSide to offset: "))
        (vl-cmdf "_.offset" od e p "")
        (setq obj2 (vlax-ename->vla-object (entlast)))
        (if (= closed 0)
          (progn
            (setq start (@2d (vlax-curve-getstartpoint Obj1)))
            (setq end (@2d (vlax-curve-getendpoint Obj1)))
            (setq coords (vlax-get Obj2 'Coordinates))
            (vlax-put Obj2 'Coordinates (append start coords end))
            1
          )
          1
        )
        (vl-cmdf "_.-HATCH" "PR" "LINE" 0.125 50 "_S" (vlax-vla-object->ename Obj1) (vlax-vla-object->ename Obj2) "" "")
	(setq newhatch (vlax-ename->vla-object (entlast)))
        (vla-delete Obj2)
      )
    )
  )
  (*error* nil)
 (setvar "OSMODE" os)
 (command "_linetype" "s" "bylayer" "") 
 (setvar "CLAYER" "0")
 (princ)
)

 

It should work, I haven't made any major changes. Removed the part about the offset request and put, as you said, always 0.50. In the end I inserted the new hatch with the features listed, changing the units of the drawing, which I have on decimal degrees.

Guest

Guest

Posted
Posted

Thanks confutatis. I want to ask you something else. is it possible to work for LWPOLYLINES and LINES ?

 

I try 

(= etyp "LWPOLYLINE,LINE")

 

But is not working

 

Thanks

confutatis Enthusiast

confutatis

Posted
Posted (edited)

 

In this case, the changes already become heavier, the two entities are completely different and have different properties and therefore need to be treated differently. As soon as I have a moment I'll try.

 

As a first step, you can decide the selection with an appropriate handling of the function ssget:

  

(setq sel (ssget "_+.:E:S"  '((-4 . "<OR") (0 . "LWPOLYLINE") (0 . "LINE") (-4 . "OR>")))
(setq e (ssname sel 0))

 

In this way I can emulate the entsel function with these options of ssget, limited to a single entity that can be only line or lwpolyline. One can eventually indulge in a thousand modifications.

Edited by confutatis
BIGAL Grand Master

BIGAL

Posted
Posted

I answered this maybe Theswamp just pick a point inside a closed area does not have to be a building, by using bpoly allows for object to have more than 1 layer. 

 

image.png.ad5ab58e260d104a33dc308f8458d7a8.png

Guest

Guest

Posted
Posted

Hi BIGAL. I know this lisp code but works better with close polylines. If i have an open building (open poolyline) i must play with the angle of the hatch .

Thanks

confutatis Enthusiast

confutatis

Posted
Posted 
(defun C:HB3 ( / *error* Doc vars vals ans od e ent etyp Obj1 p Obj2 start end coords array)
  (gc)
  (vl-load-com)
  (setq os (getvar "OSMODE"))
  (vl-cmdf "_layer" "_m" "HATCH" "_c" "171" "" "_lw" "0.15" "" "")
  (or *acad* (setq *acad* (vlax-get-acad-object)))
  (setq Doc (vla-get-ActiveDocument *acad*))
  (setq vars '("cmdecho"))
  (setq vals (mapcar 'getvar vars))
  (defun *error* (Error)
    (mapcar 'setvar vars vals)
    (if e (redraw e 4))
    (vla-endundomark Doc)
    (cond
      ((not Error))
      ((wcmatch (strcase Error) "*QUIT*,*CANCEL*")
        ;(vl-exit-with-error "\r                                              ")
      )
      (1
        (princ (strcat "\n*ERROR*: " Error))
        ;(vl-exit-with-error (strcat "\r*ERROR*: " Error))
      )
    )
    (setvar "NOMUTT" 0)
    (princ)
  )
  (vla-endundomark Doc)
  (vla-startundomark Doc)
  (mapcar 'setvar vars '(0))
  (command "_.EXPERT" (getvar "EXPERT"))
 
  (defun @2d (p)(list (car p)(cadr p)))
 
  (and
    (setq od 0.50)
    (or (entmake) 1)
    (setvar "errno" 0)
    (while (/= (getvar "errno") 52)
      (if e (redraw e 4))
        (setvar "NOMUTT" 1)
	(princ "Select object to offset: ")
        (setq sel (ssget "_+.:E:S"  '((-4 . "<OR") (0 . "LWPOLYLINE") (0 . "LINE") (-4 . "OR>"))))
	(setvar "NOMUTT" 0)
        (if (null sel)
	 (vl-exit-with-error "")
	) 
	(setq e (ssname sel 0))
        (setq Obj1 (vlax-ename->vla-object e))
        (setq etyp (cdr (assoc 0 (entget e))))
        (or (redraw e 3) 1)
        (setq p (getpoint "\nSide to offset: "))
        (vl-cmdf "_.offset" od e p "")
        (setq obj2 (vlax-ename->vla-object (entlast)))

	(if (= etyp "LINE")
         (progn
          (setq start2 (@2d (vlax-curve-getstartpoint Obj2)))
          (setq end2 (@2d (vlax-curve-getendpoint Obj2)))
          (vla-delete obj2)
	  (setq array (vlax-make-safearray vlax-vbDouble (cons 0 (- (length (apply 'append (list start2 end2))) 1))))
	  (setq Obj2 (vla-addlightweightpolyline (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
		      (vlax-make-variant (vlax-safearray-fill array (apply 'append (list start2 end2))))
	             )
	  )	
         )
        ) 

        (if (and (= etyp "LWPOLYLINE") (= (vla-get-Closed Obj1) :vlax-false))
          (progn
            (setq start (@2d (vlax-curve-getstartpoint Obj1)))
            (setq end (@2d (vlax-curve-getendpoint Obj1)))
            (setq coords (vlax-get Obj2 'Coordinates))
            (vlax-put Obj2 'Coordinates (append start coords end))
            1
          )
          1
        )
        (vl-cmdf "_.-HATCH" "PR" "LINE" 0.125 50 "_S" (vlax-vla-object->ename Obj1) (vlax-vla-object->ename Obj2) "" "")
        (vla-delete Obj2)
    )
  )
  (*error* nil)
 (setvar "OSMODE" os)
 (command "_linetype" "s" "bylayer" "") 
 (setvar "CLAYER" "0")
 (princ)
)

 

That's it, now it also handles the lines.

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...