Author Topic: Hatch with offset  (Read 1854 times)

0 Members and 1 Guest are viewing this topic.

milanp

  • Newt
  • Posts: 35
Hatch with offset
« on: September 16, 2020, 05:33:50 PM »
Hello

Does anyone have a lisp or an idea of how to make a lisp for automatic offset hatching?

My routine:
-create polyline around object
-offset polyline inside
-set ucs on object sides
-hatch (angle 0 or 90 degrees for Ansi31, or Solid with special color (210,255,199 or 220,220,200))
-detele polyline

I have a lot of objects and this is going very slowly
Can some lisp speed up the process?

Thanks! :)


BIGAL

  • Swamp Rat
  • Posts: 1396
  • 40 + years of using Autocad
Re: Hatch with offset
« Reply #1 on: September 16, 2020, 08:37:29 PM »
To answer properly need this answered.

"-create polyline around object" what is object some random shape ?

Need a sample dwg.

Pline around random objects can be easy or very hard. Orientate hatch to longer side not a problem. Angled objects should not be a problem.



A man who never made a mistake never made anything

milanp

  • Newt
  • Posts: 35
Re: Hatch with offset
« Reply #2 on: September 17, 2020, 08:00:28 AM »
Is it possible to create hatch (Ansi31), scale it with 0.8 in basepoint of hatch and align with the longer side? Maybe that's the fastest way? Thanks!

BIGAL

  • Swamp Rat
  • Posts: 1396
  • 40 + years of using Autocad
Re: Hatch with offset
« Reply #3 on: September 17, 2020, 11:39:14 PM »
Again what is object ? If its a pline rectang then easy, need true objects to test, post a dwg.
A man who never made a mistake never made anything

milanp

  • Newt
  • Posts: 35
Re: Hatch with offset
« Reply #4 on: September 18, 2020, 02:22:07 AM »
Lines in 2d and sometimes in 3d. If the problem is for 3d then you don't have to for that. I attached dwg. Thanks!

Marco Jacinto

  • Newt
  • Posts: 47
Re: Hatch with offset
« Reply #5 on: September 18, 2020, 12:54:18 PM »
Maybe this can help



Code: [Select]
(DEFUN c:ofin (/        ANCHOPOLILINEA          BO           DISTANCIAOFFSET         ELAST          OBJ       OLDLAY
           PLINENUEVA   COLORLAY     NOMBRELAY    PTIN
          )
  ;;;Se establece un inicio de uno, asi al desacher el comando se  ;;;regresara al estado del dibujo antes de comenzar ofin  (COMMAND "_undo" "_be")
  ;;;Se graba el layer actual  (SETQ oldLay (GETVAR "clayer"))
  ;;;Se establece el nombre que tendra el nuevo layer  (SETQ NombreLay "VALORIZA MURO")
  ;;;El color del nuevo layer  (SETQ ColorLay 28)
  ;;;La separacion de la nueva polilinea  (SETQ DistanciaOffset 0.025)
  ;;;El ancho de la nueva polilinea, se considera que esta  ;;;sera el doble de la separacion, para no dejar ningun  ;;;ajuste  (SETQ AnchoPolilinea (* DistanciaOffset 2))
  ;;;Se apaga el eco de comandos, con esto no se vera el  ;;;proceso de ninguna de las llamadas a la funcion  ;;;command  (SETVAR "cmdecho" 0)
  ;;;si no existe el layer nuevo  (OR (TBLSEARCH "layer" NombreLay)
      ;;;se crea el nuevo layer      (COMMAND "_-layer" "_new" NombreLay "_color" ColorLay ""    "")
  )
  ;;;se establece el nuevo layer como el actual  (SETVAR "clayer" NombreLay)
  ;;;Se apagan todos los layers menos el actual, los muros y columnas  (command "_-layer" "_off" "*" "_no" "on" "*MURO*,*COLUMNA*" "")
  ;;;mientras exista ptin, se creara la polilinea interior  (SETQ ptin T);_con este valor se entra al ciclo  (WHILE ptin
    (IF    (AND (SETQ ptin (GETPOINT "\n Especifica un punto interno: "))
         (SETQ elast (ENTLAST));_Se graba la ultima entidad          (SETQ bo (BPOLY ptin));_Se graba el contorno creado         (/= elast bo);_Se compara la ultima entidad y el nuevo contorno    )
      (PROGN
    ;;;Se crea la polilinea nueva al interior del contorno creado.    (COMMAND "_offset" DistanciaOffset bo ptin "")
    (AND
      ;;;Se obtiene la nueva polilinea para compararla con el contorno      (SETQ PlineNueva (ENTLAST))
      (/= PlineNueva bo)
      ;;;Se cambia el ancho de la polilinea al valor establecido      (VLA-PUT-CONSTANTWIDTH
        (SETQ obj (VLAX-ENAME->VLA-OBJECT PlineNueva))
        AnchoPolilinea
      )
    )
    ;;;Se borra el contorno creado    (AND bo (ENTDEL bo))
    ;;;Se manda la polilinea nueva al fondo    (COMMAND "_draworder" PlineNueva "" "_back")
      )
    )
  )
  ;;;Se regresa al estado anterior de layers  (command "layerp")
  ;;;Se restaura el layer original  (SETVAR "clayer" oldLay)
  ;;;Se cierra el undo  (COMMAND "_undo" "_end")
  (PRINC)
)

milanp

  • Newt
  • Posts: 35
Re: Hatch with offset
« Reply #6 on: September 18, 2020, 02:25:46 PM »
I found this lisp: *Author Alan J. Thompson, 09.12.09*

Code: [Select]
;;; Offset inside of selected objects
;;; Alan J. Thompson, 09.12.09
(defun c:OffIn (/ #Dist #SSGet #Pline #Offset)
 (vl-load-com)
 (initget 6)
 (cond
   ((and (setq #Dist (getdist "\nSpecify offset distance: "))
         (setq #SSGet (ssget ":L" '((0 . "LINE,LWPOLYLINE,ARC"))))
    ) ;_ and
    (if (zerop (getvar "peditaccept"))
      (vl-cmdf "_.pedit" "_m" #SSGet "" "_y" "_j" "" "")
      (vl-cmdf "_.pedit" "_m" #SSGet "" "_j" "" "")
    ) ;_ if
    (if (not (vl-catch-all-error-p
               (setq
                 #Offset
                  (vl-catch-all-apply
                    'vla-offset
                    (list (setq
                            #Pline (vlax-ename->vla-object (entlast))
                          ) ;_ setq
                          (abs #Dist)
                    ) ;_ list
                  ) ;_ vl-catch-all-apply
               ) ;_ setq
             ) ;_ vl-catch-all-error-p
        ) ;_ not
      (if (> (vla-get-area
               (setq #Offset (car (vlax-safearray->list
                                    (vlax-variant-value #Offset)
                                  ) ;_ vlax-safearray->list
                             ) ;_ car
               ) ;_ setq
             ) ;_ vla-get-area
             (vla-get-area #Pline)
          ) ;_ >
        (progn
          (vla-delete #Offset)
          (if (not (vl-catch-all-error-p
                     (setq #Offset (vl-catch-all-apply
                                     'vla-offset
                                     (list #Pline (- (abs #Dist)))
                                   ) ;_ vl-catch-all-apply
                     ) ;_ setq
                   ) ;_ vl-catch-all-error-p
              ) ;_ not
            (setq #Offset (car (vlax-safearray->list
                                 (vlax-variant-value #Offset)
                               ) ;_ vlax-safearray->list
                          ) ;_ car
            ) ;_ setq
            (setq #Offset nil)
          ) ;_ if
        ) ;_ progn
      ) ;_ if
      (alert "Item cannot be offset.")
    ) ;_ if
    (and #Pline (vla-explode #Pline))
   )
 ) ;_ cond
 (princ)
) ;_ defun

I added
(command "_move""_all""""""0,0,1e99""_move""_all""""""0,0,-1e99") - to move lines from 3d to 2d. This is not good because all drawings set Z 0
(command "_.-hatch" "P" "SOLID" "\\" "") - run solid hatch
(vla-delete #Pline) - delete pline
(vla-delete #Offset) - detele offset
(command "-purge" "z") - delete lines with 0 length. I don't know why those lines appear in the corners.


Changed lisp:

Code: [Select]
(defun c:OffIn (/ #Dist #SSGet #Pline #Offset)
(command "_move""_all""""""0,0,1e99""_move""_all""""""0,0,-1e99")
 (vl-load-com)
 (initget 6)
 (cond
   ((and (setq #Dist (getdist "\nSpecify offset distance: "))
         (setq #SSGet (ssget ":L" '((0 . "LINE,LWPOLYLINE,ARC"))))
    ) ;_ and
    (if (zerop (getvar "peditaccept"))
      (vl-cmdf "_.pedit" "_m" #SSGet "" "_y" "_j" "" "")
      (vl-cmdf "_.pedit" "_m" #SSGet "" "_j" "" "")
    ) ;_ if
    (if (not (vl-catch-all-error-p
               (setq
                 #Offset
                  (vl-catch-all-apply
                    'vla-offset
                    (list (setq
                            #Pline (vlax-ename->vla-object (entlast))
                          ) ;_ setq
                          (abs #Dist)
                    ) ;_ list
                  ) ;_ vl-catch-all-apply
               ) ;_ setq
             ) ;_ vl-catch-all-error-p
        ) ;_ not
      (if (> (vla-get-area
               (setq #Offset (car (vlax-safearray->list
                                    (vlax-variant-value #Offset)
                                  ) ;_ vlax-safearray->list
                             ) ;_ car
               ) ;_ setq
             ) ;_ vla-get-area
             (vla-get-area #Pline)
          ) ;_ >
        (progn
          (vla-delete #Offset)
          (if (not (vl-catch-all-error-p
                     (setq #Offset (vl-catch-all-apply
                                     'vla-offset
                                     (list #Pline (- (abs #Dist)))
                                   ) ;_ vl-catch-all-apply
                     ) ;_ setq
                   ) ;_ vl-catch-all-error-p
              ) ;_ not
            (setq #Offset (car (vlax-safearray->list
                                 (vlax-variant-value #Offset)
                               ) ;_ vlax-safearray->list
                          ) ;_ car
            ) ;_ setq
            (setq #Offset nil)
          ) ;_ if
        ) ;_ progn
      ) ;_ if
      (alert "Item cannot be offset.")
    ) ;_ if
    (and #Pline (vla-explode #Pline))
(command "_.-hatch" "P" "SOLID" "\\" "")
(vla-delete #Pline)
(vla-delete #Offset)
(command "-purge" "z")
   )
 ) ;_ cond
 (princ)
) ;_ defun

Everything works properly BUT
after selecting an object I have to click inside the object again for it to appear solid hatch. Can it be set to be automatic and for multiple objects at once?

I attached gif example- offset hatch one object.

Thanks! :)



« Last Edit: September 18, 2020, 04:06:12 PM by milanp »

BIGAL

  • Swamp Rat
  • Posts: 1396
  • 40 + years of using Autocad
Re: Hatch with offset
« Reply #7 on: September 18, 2020, 11:03:55 PM »
If its closed object nothing inside can be all lines even crossing so long as there is a closed internal shape then bpoly will make a new pline and then you offset that and hatch.

Code: [Select]
(setq off (getreal "\nEnter offset"))
(while (setq pt (getpoint "\nPick internal pt"))
(command "bpoly" pt "")
(setq ent1 (entlast))
(command "offset" off ent1 pt "")
(setq ent2 (entlast))
(command "erase" ent1 "")
(setvar 'hpname "Solid")
(command "-hatch" pt "")
)



A man who never made a mistake never made anything

milanp

  • Newt
  • Posts: 35
Re: Hatch with offset
« Reply #8 on: September 19, 2020, 01:58:03 PM »
Short and simple. 3d lines I can isolate, set to zero and then apply your lisp. Thank you BIGAL for your time. It will help me a lot.