Jump to content

COPY HATCH

leonucadomi

By leonucadomi
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

leonucadomi Rising Star

leonucadomi

Posted
Posted

Good afternoon, is there any way to select a hatch and then click an area and generate that same hatch?

 

with the same properties.

 

 

Link to comment
Share on other sites
  • Replies 20
  • Created
  • Last Reply

Top Posters In This Topic

  • ronjonp

    6

  • aridzv

    5

  • 3dwannab

    3

  • leonucadomi

    2

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

ronjonp
ronjonp

@leonucadomi Give this a try: (defun c:foo (/ a b e h hp p x) ;; RJP » 2022-09-08 (cond ((and (setq e (car (entsel "\nPick source hatch: "))) (= "HATCH" (cdr (assoc 0 (entget e))))

ronjonp
ronjonp

My code above matches colors as well as gradients 🤓

ronjonp
ronjonp

MA - Matchprop.

Posted Images

Steven P Grand Master

Steven P

Posted
Posted

as described, yes it is possible though match properties could be nearly as easy. I'd have to dig about later today to put something together, nut personally I'd do as RonJonP

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

An extra comment ok copy hatch from another dwg, then paste into current dwg, then use matchprop but hatches go silly, this is caused by a quirk in hatches, we worked in real world co-ordinates, 580,000 270,000 so the fix is simple, you reset the hatch origin point by picking a point in current dwg area, look in properties, eg Conc hatch pattern, some of the others are affected also but not all.

Link to comment
Share on other sites
leonucadomi Rising Star

leonucadomi

Posted
  • Author
Posted

I do it by copying properties with MA - Matchprop., but but i want to make fewer moves ,

 

and what occurs to me is to touch a hatch , capture their properties and copy them by selecting a point within an area.

 

it would be a total of two steps.

 

1.- (entsel)  the origin hatch

 

 

2.- (getpoint)  the interior point of the area.

 

they are just my ideas. :)

 

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

Write the steps down for a manual version, that is the same you need to do in a lisp.

 

Look into using say VL-get-layer, vla-get-name a little bit easier than (cdr (assoc 8 (entget (car ent))))

Link to comment
Share on other sites
ronjonp Grand Master

ronjonp

Posted
Posted (edited)
On 9/5/2022 at 6:23 AM, leonucadomi said:

I do it by copying properties with MA - Matchprop., but but i want to make fewer moves ,

 

and what occurs to me is to touch a hatch , capture their properties and copy them by selecting a point within an area.

 

it would be a total of two steps.

 

1.- (entsel)  the origin hatch

 

 

2.- (getpoint)  the interior point of the area.

 

they are just my ideas. :)

 

@leonucadomi Give this a try: 

(defun c:foo (/ a b e h hp p x)
  ;; RJP » 2022-09-08
  (cond	((and (setq e (car (entsel "\nPick source hatch: ")))
	      (= "HATCH" (cdr (assoc 0 (entget e))))
	      (setq b (assoc 2 (entget e)))
	      (setq e (vlax-ename->vla-object e))
	      (setq a (mapcar '(lambda (x) (list x (vlax-get e x)))
			      '(associativehatch   backgroundcolor    elevation
				entitytransparency gradientangle      gradientcentered
				gradientcolor1	   gradientcolor2     gradientname
				hatchobjecttype	   hatchstyle	      isopenwidth
				layer		   linetype	      linetypescale
				lineweight	   material	      origin
				patternangle	   patterndouble      patternscale
				patternspace	   plotstylename      truecolor
				visible
			       )
		      )
	      )
	 )
	 (setq hp (getvar 'hpname))
	 (setvar 'hpname (cdr b))
	 (while	(setq p (getpoint))
	   (setq h (entlast))
	   (command "_.bhatch" p "")
	   (cond ((not (equal h (setq h (entlast))))
		  (setq h (vlax-ename->vla-object h))
		  (foreach x a (vl-catch-all-apply 'vlax-put (list h (car x) (cadr x))))
		  ;; patternname (RO) cannot be set via vla for some reason ?
		  ;; (setq h (entget (vlax-vla-object->ename h)))
		  ;; (entmod (subst b (assoc 2 h) h))
		 )
	   )
	 )
	 (setvar 'hpname hp)
	)
  )
  (princ)
)

 

Edited by ronjonp
  • Like 5
  • Thanks 1
Link to comment
Share on other sites
aridzv Community Regular

aridzv

Posted
Posted (edited)

Hi @leonucadomi

I've found this topic - see if it helps.

I used it,and it's work very well.

the only thing that for me is missing there is setting the source pattern color to the new one as well.

I've tried to get the source pattern color and set it to the new one using this line but faild: 

(setvar "HPCOLOR" (setq ihatch-color (cdr (assoc 63 ent)))) ; find the Hatch color and set it

but other then that it is workig very well.

hope it will help you.

aridzv.

Edited by aridzv
Link to comment
Share on other sites
aridzv Community Regular

aridzv

Posted
Posted (edited)

Hi @ronjonp

I've tried to use your code but it failed.

when i run the code it lets me pick the source hatch and then the lisp ends without 

continue to the HATCH command and without any error massages  - it just ends...

I'm using Bricscad so mybe that is the reason and some adjusment need to be done?

 

regards,

aridzv.

Edited by aridzv
Link to comment
Share on other sites
ronjonp Grand Master

ronjonp

Posted
Posted
15 minutes ago, aridzv said:

Hi @ronjonp

I've tried to use your code but it failed.

when i run the code it lets me pick source hatch and then the lisp ends without 

continue to the HATCH command and without any error massages  - it just ends...

I'm using Bricscad so mybe that is the reason and some adjusment need to be done?

 

regards,

aridzv.

Strange ... maybe you can debug it in the BLADE editor?

Link to comment
Share on other sites
aridzv Community Regular

aridzv

Posted
Posted (edited)
12 minutes ago, ronjonp said:

Strange ... maybe you can debug it in the BLADE editor?

@ronjonp - O.K., got it...

here is a screenshot of the error I get when debugging with BLADE:

Capture1.thumb.PNG.e0f8024237ee1cb3aa673a187990af0e.PNG

Edited by aridzv
Link to comment
Share on other sites
aridzv Community Regular

aridzv

Posted
Posted (edited)

@ronjonp

O.K.!!

I've remooved gradientcolor1 & gradientcolor2 from the properties list and it's working!!

In addition to the new lisp, I also learned about the BLADE debugging tool,

so thanks x 2.. 🙂

 

regards,

aridzv

Edited by aridzv
Link to comment
Share on other sites
ronjonp Grand Master

ronjonp

Posted
Posted
1 minute ago, aridzv said:

@ronjonp

O.K.!!

I've remooved gradientcolor1 & gradientcolor2 from the properties list and it working!!

In addition to the new lisp, I also learned about the BLADE debugging tool,

so thanks x 2.. 🙂

 

regards,

aridzv

🍻

  • Like 1
Link to comment
Share on other sites
  • 5 months later...
3dwannab Proficient

3dwannab

Posted
Posted
On 9/9/2022 at 2:40 PM, ronjonp said:

My code above matches colors as well as gradients 🤓

2022-09-09_07-43-15.gif

 

Nice program. :)

 

I was hoping to retain the boundaries. I've modified the script to include "Undo handling, hiding objects and retain boundaries).

 

Is it doable to retain the boundaries but set the layer to something?

 

Here's my version: 

(defun c:foo (/ *error* a b e h hp p x ssHide var_cmdecho var_hpannotative var_hpassoc var_hpbound var_hpboundretain var_hpseparate var_osmode var_selectioncycling var_snapmode)

  ;  2023.03.03, 3dwannab edit, added undo handling and hiding objects, also retain boundaries.

  (defun *error* (errmsg)
    (and acDoc (vla-EndUndoMark acDoc))
    (and errmsg
         (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
         (princ (strcat "\n<< Error: " errmsg " >>\n"))
    )

    ;;; Unhides the selection set
    (if ssHide (acet-ss-visible ssHide 0))

    (setvar 'cmdecho var_cmdecho)
    (setvar 'hpannotative var_hpannotative)
    (setvar 'hpassoc var_hpassoc)
    ; (setvar 'hpbackgroundcolor var_hpbackgroundcolor) ;; No need to use this. The add selected command will get this.
    (setvar 'hpbound var_hpbound)
    (setvar 'hpboundretain var_hpboundretain)
    (setvar 'hpseparate var_hpseparate)
    (setvar 'osmode var_osmode)
    (setvar 'selectioncycling var_selectioncycling)
    (setvar 'snapmode var_snapmode)
  )

  (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc))

  (setq var_cmdecho (getvar "cmdecho"))
  (setq var_hpannotative (getvar "hpannotative"))
  (setq var_hpassoc (getvar "hpassoc"))
  ; (setq var_hpbackgroundcolor (getvar "hpbackgroundcolor")) ;; No need to use this. The add selected command will get this.
  (setq var_hpbound (getvar "hpbound"))
  (setq var_hpboundretain (getvar "hpboundretain"))
  (setq var_hpseparate (getvar "hpseparate"))
  (setq var_osmode (getvar "osmode"))
  (setq var_selectioncycling (getvar "selectioncycling"))
  (setq var_snapmode (getvar "snapmode"))

  (setvar 'osmode 0)
  (setvar 'cmdecho 0)
  (setvar 'hpassoc 1)
  ; (setvar 'hpbackgroundcolor ".") ;; No need to use this. The add selected command will get this.
  (setvar 'hpbound 1) ; Create polyline boundary
  (setvar 'hpboundretain 1) ; Retain boundaries
  (setvar 'hpseparate 1) ; Separates the hatches to each boundary.
  (setvar 'selectioncycling 2) ;; 0 = The display options are turned off, 1 = A badge displays when you hover over objects that overlap, 2 = Both a badge and the Selection dialog box displays.
  (setvar 'snapmode 0) ; gridsnap: 0 off, 1 = 0n

  ;; Put any text, leaders, multileaders or dimensions into a selection set and
  ;; hides them. The error handler will undo this.
  (setq ssHide (ssget "_X" '((0 . "*TEXT,LEADER,MULTILEADER,DIMENSION"))))

  (acet-ss-visible ssHide 1) ; Hides ssHide

  ;; RJP » 2022-09-08
  (cond
    ((and (setq e (car (entsel "\nPick source hatch: ")))
          (= "HATCH" (cdr (assoc 0 (entget e))))
          (setq b (assoc 2 (entget e)))
          (setq e (vlax-ename->vla-object e))
          (setq a (mapcar '(lambda (x) (list x (vlax-get e x)))
                          '(associativehatch backgroundcolor elevation entitytransparency gradientangle gradientcentered gradientcolor1 gradientcolor2 gradientname hatchobjecttype hatchstyle isopenwidth layer linetype linetypescale lineweight material origin patternangle patterndouble patternscale patternspace plotstylename truecolor visible)
                  )
          )
     )
     (setq hp (getvar 'hpname))
     (setvar 'hpname (cdr b))

     (setvar 'hpboundretain 1) ; Retain boundaries

     (while (setq p (getpoint))
       (setq h (entlast))
       (command "_.bhatch" p "")
       (cond
         ((not (equal h (setq h (entlast))))
          (setq h (vlax-ename->vla-object h))
          (foreach x a (vl-catch-all-apply 'vlax-put (list h (car x) (cadr x))))
          ;; patternname (RO) cannot be set via vla for some reason ?
          ;; (setq h (entget (vlax-vla-object->ename h)))
          ;; (entmod (subst b (assoc 2 h) h))
         )
       )
     )
     (setvar 'hpname hp)
    )
  )

  (*error* nil)
  (princ)
)

 

Link to comment
Share on other sites
  • 4 months later...
3dwannab Proficient

3dwannab

Posted
Posted (edited)

Trying to fix the issue where the gradientangle gradientcentered gradientcolor1 gradientcolor2 gradientname properties are unavailable.

 

dumpAllProperties shows this for the problem hatch object attached.

  

GradientAngle (type: double)  (LocalName: Gradient Angle) = Failed to get value
GradientCentered (type: bool)  (LocalName: Centered) = Failed to get value
GradientColor1 (type: AcCmColor)  (LocalName: Color 1) = Failed to get value
GradientColor2 (type: AcCmColor)  (LocalName: Color 2) = Failed to get value
GradientName (type: HatchGradientNameEnum)  (LocalName: Gradient name) = Failed to get value

 

 

I tried to solve it with this but no luck.

  

;; Problem props
(setq props '(associativehatch backgroundcolor elevation entitytransparency gradientangle gradientcentered gradientcolor1 gradientcolor2 gradientname hatchobjecttype hatchstyle isopenwidth layer linetype linetypescale lineweight material origin patternangle patterndouble patternscale patternspace plotstylename truecolor visible))

;; This works by removing: gradientangle gradientcentered gradientcolor1 gradientcolor2 gradientname
; (setq props '(associativehatch backgroundcolor elevation entitytransparency hatchobjecttype hatchstyle isopenwidth layer linetype linetypescale lineweight material origin patternangle patterndouble patternscale patternspace plotstylename truecolor visible))

(setq ent (car (entsel "\nSelect Bad Bad Hatch : ")))
(setq en (vlax-ename->vla-object ent))
(setq enprops (vl-remove 'nil (mapcar '(lambda (p) (if (vlax-property-available-p en p f) (cons p (vlax-get-property en p)))) props)))

(princ enprops)

 

99 Hatch Problems.dwg

Edited by 3dwannab
Link to comment
Share on other sites

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...