Create a solid hatch with trasparency from an open pline

[MastroLube]

Hello again!

I've a little task to ask.. I have some polylines with three vertices. I want to select them and create a solid hatch with a trasparency (50%).

I digged inside the "-hatch" command and it asks for an object or to draw the boundaries.

My idea is:

1. select them and create a selection set

2. dig inside that selection and get their points

3. add the last one point which have the X coordinate of the 1st point and the Y coordinate of the 3th

4. now I have a list of point for the -hatch command and I can run it.

 

 

There is a better way using visual lisp maybe?

 

Thank you for your help!

Dennis

 

Edited October 5, 2018 by MastroLube

[f700es]

Draw a temporary boundary, create your hatches and then delete the boundaries. Use draw order and send your hatches to the back as well.

[BIGAL]

To automate just use a bounding box lisp for the pline this give the two corners so can draw a 4 side shape hatch then erase. If you dont have rectangs it will not work for non 90 side need to work from co-ordinates different solution. 

 

(defun c:test ( / obj p2 p3 bl ur)

(setq obj (vlax-ename->vla-object (car (entsel "\nPick pline "))))
(vla-getboundingbox obj 'bl 'ur)
(setq bl (vlax-safearray->list bl))
(setq bl (list (car bl)(cadr bl)))
(setq ur (vlax-safearray->list ur))
(setq ur (list (car ur)(cadr ur)))
(setq p2 (list (car ur)(cadr bl)))
(setq p3 (list (car bl)(cadr ur)))
(command "pline" bl p2 ur p3 "c")
(setq obj (entlast))
(setq x (/ (+ (car bl)(car ur)) 2.0))
(setq y (/ (+ (cadr bl)(cadr ur)) 2.0))
(setq p2 (list x y))
(setvar "hpname" "net")
(command "-hatch" p2 "")
(command "erase" obj "")

)

 

[MastroLube]

8 hours ago, BIGAL said:

To automate just use a bounding box lisp for the pline this give the two corners so can draw a 4 side shape hatch then erase. If you dont have rectangs it will not work for non 90 side need to work from co-ordinates different solution. 

 

 

Thank you Bigal! I didn't know that function to get bounding box!

 

This is my version

 

(DEFUN c:test2 (/ obj p2 p3 bl ur pl e s osmode)
  (command "_undo" "_BE")
  (setq oldsnap (getvar 'osmode))
  (setvar 'osmode 0)
  (IF (SETQ s (SSGET "_:L" '((0 . "LWPOLYLINE") (8 . "CB_GENERATRICI"))))
    
    (WHILE (SETQ e (SSNAME s 0))
      (SETQ obj (VLAX-ENAME->VLA-OBJECT e))
      (VLA-GETBOUNDINGBOX obj 'bl 'ur)
      (SETQ bl (VLAX-SAFEARRAY->LIST bl))
      (SETQ bl (LIST (CAR bl) (CADR bl)))
      (SETQ ur (VLAX-SAFEARRAY->LIST ur))
      (SETQ ur (LIST (CAR ur) (CADR ur)))
      (SETQ p2 (LIST (CAR ur) (CADR bl)))
      (SETQ p3 (LIST (CAR bl) (CADR ur)))
      (COMMAND "_pline" bl p2 ur p3 "_c")
      (SETQ obj (ENTLAST))
      (SETVAR "hpname" "solid")
      (COMMAND "-hatch" "_T" "50" "_S" obj "" "")
      (COMMAND "erase" obj "")
      (SSDEL e s)
    )
  )
  (command "_undo" "_E")
  (setvar 'osmode oldsnap)
  (PRINC)
)

I didn't get the part of "x" and "y" in your code anyway, maybe it was something extra

Edited October 4, 2018 by MastroLube

[ronjonp]

4 hours ago, MastroLube said:

Thank you Bigal! I didn't know that function to get bounding box!

 

This is my version

 

(DEFUN c:test2 (/ obj p2 p3 bl ur pl e s osmode)
  (command "_undo" "_BE")
  (setq oldsnap (getvar 'osmode))
  (setvar 'osmode 0)
  (IF (SETQ s (SSGET "_:L" '((0 . "LWPOLYLINE") (8 . "CB_GENERATRICI"))))
    
    (WHILE (SETQ e (SSNAME s 0))
      (SETQ obj (VLAX-ENAME->VLA-OBJECT e))
      (VLA-GETBOUNDINGBOX obj 'bl 'ur)
      (SETQ bl (VLAX-SAFEARRAY->LIST bl))
      (SETQ bl (LIST (CAR bl) (CADR bl)))
      (SETQ ur (VLAX-SAFEARRAY->LIST ur))
      (SETQ ur (LIST (CAR ur) (CADR ur)))
      (SETQ p2 (LIST (CAR ur) (CADR bl)))
      (SETQ p3 (LIST (CAR bl) (CADR ur)))
      (COMMAND "_pline" bl p2 ur p3 "_c")
      (SETQ obj (ENTLAST))
      (SETVAR "hpname" "solid")
      (COMMAND "-hatch" "_T" "50" "_S" obj "" "")
      (COMMAND "erase" obj "")
      (SSDEL e s)
    )
  )
  (command "_undo" "_E")
  (setvar 'osmode oldsnap)
  (PRINC)
)

I didn't get the part of "x" and "y" in your code anyway, maybe it was something extra

FWIW .. since you're calling a command you could use 'rectang' and not need to calc the other 2 points.

(defun c:test2 (/ bl e obj oldsnap s ur)
  (command "_undo" "_BE")
  (setq oldsnap (getvar 'osmode))
  (setvar 'osmode 0)
  (if (setq s (ssget "_:L" '((0 . "LWPOLYLINE") (8 . "CB_GENERATRICI"))))
    (while (setq e (ssname s 0))
      (setq obj (vlax-ename->vla-object e))
      (vla-getboundingbox obj 'bl 'ur)
      (setq bl (vlax-safearray->list bl))
      (setq ur (vlax-safearray->list ur))
      ;; (command "_pline" bl p2 ur p3 "_c")
      (command "_.rectang" bl ur)
      (setq obj (entlast))
      (setvar "hpname" "solid")
      (command "-hatch" "_T" "50" "_S" obj "" "")
      ;; (command "erase" obj "")
      (entdel obj)
      (ssdel e s)
    )
  )
  (command "_undo" "_E")
  (setvar 'osmode oldsnap)
  (princ)
)

 

[BIGAL]

I worked out the centre pick point but using entlast is actually much easier.

[MastroLube]

18 hours ago, ronjonp said:

FWIW .. since you're calling a command you could use 'rectang' and not need to calc the other 2 points.

Thank you for this suggestion!!

 

I'm trying to create a group of these elements, but I didn't find the way.. any suggestion?

(DEFUN c:verificasovrapposizioni (/ obj p2 p3 bl ur pl e s osmode acadObj doc groupObj appendObjs i)
  (command "_.undo" "_BE")
  (setq oldsnap (getvar 'osmode))
  (setvar 'osmode 0)
  (IF (SETQ s (SSGET "_:L" '((0 . "LWPOLYLINE") (8 . "CB_GENERATRICI"))))
  (progn
    (SETQ acadObj  (VLAX-GET-ACAD-OBJECT)
          doc      (VLA-GET-ACTIVEDOCUMENT acadObj)
          groupObj (VLA-ADD (VLA-GET-GROUPS doc) "TEST_GROUP1")
          appendObjs (vlax-make-safearray vlax-vbObject (cons 0 (- (sslength s) 1)))
          ;i 0
    )
  
      
    (WHILE (SETQ e (SSNAME s 0))
      (SETQ obj (VLAX-ENAME->VLA-OBJECT e))
      (VLA-GETBOUNDINGBOX obj 'bl 'ur)
      (SETQ bl (VLAX-SAFEARRAY->LIST bl))
      
      (SETQ ur (VLAX-SAFEARRAY->LIST ur))
      (command "_.rectang" bl ur)
      (SETQ obj (ENTLAST))
      (SETVAR "hpname" "solid")
      (COMMAND "_-hatch" "_T" "50" "_S" obj "" "")
      ;(grp:append-objects "verifica" (entget (entlast)))
      ;(vlax-safearray-put-element appendObjs i (VLAX-ENAME->VLA-OBJECT (entlast)))
      ;(vla-AppendItems groupObj appendObjs)
      ;(command "_-group" "_Add" "_TEST_GROUP1" (entlast))
      (COMMAND "_.erase" obj "")
      (SSDEL e s)
      ;(setq i (1+ i))
    )
    )
    
  )
  (command "_.undo" "_E")
  (setvar 'osmode oldsnap)
  (PRINC)
)

 

[ronjonp]

Give this a try:

(defun c:verificasovrapposizioni (/ bl e groupobj l obj oldsnap s ur)
  (command "_.undo" "_BE")
  (setq oldsnap (getvar 'osmode))
  (setvar 'osmode 0)
  (if (setq s (ssget "_:L" '((0 . "LWPOLYLINE") (8 . "CB_GENERATRICI"))))
    (progn (setq groupobj (vla-add (vla-get-groups (vla-get-activedocument (vlax-get-acad-object)))
				   "TEST_GROUP1"
			  )
	   )
	   (while (setq e (ssname s 0))
	     (setq obj (vlax-ename->vla-object e))
	     ;; Collect polyline
	     (setq l (cons obj l))
	     (vla-getboundingbox obj 'bl 'ur)
	     (command "_.rectang" (vlax-safearray->list bl) (vlax-safearray->list ur))
	     (setq obj (entlast))
	     (setvar "hpname" "solid")
	     (command "_-hatch" "_T" "50" "_S" obj "" "")
	     ;; Collect hatch
	     (setq l (cons (vlax-ename->vla-object (entlast)) l))
	     (command "_.erase" obj "")
	     (ssdel e s)
	   )
	   ;; Add the items to the group
	   (vlax-invoke groupobj 'appenditems l)
    )
  )
  (command "_.undo" "_E")
  (setvar 'osmode oldsnap)
  (princ)
)