Zebra line-lisp

[Anonymous]

Hi all,
Do you happen to know how to solve this problem.
I need to draw special "linetypes". This line is similar as a "zebra line".
I've created lisp program, which produces two offests from polyline. It uses middle pline, between polylines.
Middle pline has dashed linetypes and specific measure. This lisp prg runs well.
The problem of this solve is global-ltscale, which changes character of the "zebra line" (in the middle of the plines).
What do you think about this workflow : exploding middle "zebra line" to rectagnles whith solid.
But in this case, I don't know how to write it in the lisp prg.
Another way could be pline drawing, offset it, lines adding which have measured intervals and in the end hatching areas between small lines.

Thank you for your advice you can provide.

[ВeekeeCZ]

This result would be good enough?

[Kent1Cooper]

---

@Anonymous wrote:

....
What do you think about this workflow : exploding middle "zebra line" to rectagnles whith solid. ....
Another way could be pline drawing, offset it, lines adding which have measured intervals and in the end hatching areas between small lines. ....

---

It's a lot easier than that.  Make sure the PLINEGEN System Variable is set to 1 [linetype generation enabled] when you draw the Polyline, so that the linetype of the middle one will "wrap" around vertices.  Use the EVENDASH linetype for the middle Polyline rather than Dashed, at an appropriate linetype scale [change the 0.1 in (* d1 0.1) -- in your drawing, a resultant linetype scale of 40 results in something that looks like your desired effect].

[Anonymous]

 Hi, yes, it look good, but when i change ltscale, it is bad.

[ВeekeeCZ]

I see... then don't... I don't.

Anyway...

You can use this routine to explode a linetype:
http://www.cadforum.cz/cadforum_en/tips.asp?t=LINEXP.LSP 
Then catch all new entites and HATCH them.

... your program ...
(setq l (entlast)
      ss (ssadd))
(C:LINEXP)
(while (setq l (entnext l)) (ssadd enl ss))
(command "_.-HATCH" "_P" "_S" "_S" ss "" "")
...

To change a linetype generation use "_.PEDIT".

For double offset you can use this routine...
http://forums.augi.com/showthread.php?9932-Offset-line-both-sides-at-the-same-time

[ВeekeeCZ]

---

@Anonymous wrote:

Hi all,
Do you happen to know how to solve this problem.
I need to draw special "linetypes". This line is similar as a "zebra line".
I've created lisp program, which produces two offests from polyline. It uses middle pline, between polylines.
Middle pline has dashed linetypes and specific measure. This lisp prg runs well.
The problem of this solve is global-ltscale, which changes character of the "zebra line" (in the middle of the plines).
What do you think about this workflow : exploding middle "zebra line" to rectagnles whith solid.
But in this case, I don't know how to write it in the lisp prg.
Another way could be pline drawing, offset it, lines adding which have measured intervals and in the end hatching areas between small lines.

Thank you for your advice you can provide.

---

Hi, I found that this could be useful for me ...

The goal is to get rid of the main disadvantages of using Linetype - extended a beginning and an end. I've tried a slightly different approach. I start from a polyline that interrupt function BREAK at appropriate intervals. Then I am folding it into a block.
I made two versions - without contours and with them.

The one without contours.

Spoiler

(vl-load-com)

(defun C:DashedAsBlock ( / *error* oVAR doc
		       	   ensel en enl lenlin lengap lenl pt width dist ss name i)

  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (princ (strcat "\nError: " errmsg)))
    (foreach e oVAR (setvar (car e) (cdr e)))
    (vla-endundomark doc)
    (princ))

  
  ;----- MAIN ROUTINE --------------------------------------------------------------------------
  (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
  (foreach e '(CMDECHO OSMODE ORTHOMODE CLAYER)
    (setq oVAR (cons (cons e (getvar e)) oVAR)))
  (setvar 'CMDECHO   0)
  (setvar 'ORTHOMODE 0)
  (setvar 'OSMODE    0)
  (command "_.UCS" "_W")
  
  (if (and (setq ensel (entsel "\nSelect a curve closer to its beginning: "))
	   (setq en (car ensel))
	   (wcmatch (cdr (assoc 0 (entget en))) "LWPOLYLINE,LINE,ARC")
	   (if (> (vlax-curve-getDistAtPoint en (vlax-curve-getClosestPointTo en (cadr ensel)))
		  (/ (vlax-curve-getDistAtPoint en (vlax-curve-getEndPoint en)) 2))
	     (if (eq (cdr (assoc 0 (entget en))) "ARC")
	       (princ "\nArc can't reverse. Linetype starts from the END!!!")
	       (progn
		 (command "_.REVERSE" en "")
		 (princ "\nCurve was reversed.")))
	     T)
	   (setvar 'CLAYER (cdr (assoc 8 (entget en))))
	   (not (command "_.CHPROP" en "" "_LA" "0" ""))
           (setq enl (entlast))
      )
    (progn
      (initget 6)
      (if (setq width (getreal "\nSet width <keep current>: "))
	(progn
	  (command "_.PEDIT" en "_W" width "")
	  (if (/= enl (entlast)) (setq enl (entlast) en enl))))
      (initget 6)
      (setq i (if (setq lenlin (getreal "\nSet length of LINE segments <start with a gap>: "))
		1
		0))
      (initget 6)
      (cond ((setq lengap (getreal (strcat "\nSet length of GAPs <" (if lenlin "equel to line" "1") ">: "))))
	    (T (setq lengap (cond (lenlin) (T 1)))))
      (if (and (not lenlin)
	       (not (initget 6))
	       (not (setq lenlin (getreal "\nSet length of LINE segments <equal to gap>: "))))
	(setq lenlin lengap))
      (setq pt0 (vlax-curve-getStartPoint en)
	    lenl (list lenlin lengap)
	    ss (ssadd))
      (if (= i 1) (ssadd en ss))

      (while (< (setq dist (nth (setq i (- 1 i)) lenl))
		(vlax-curve-getDistAtParam en (vlax-curve-getEndParam en)))
	(if (setq pt (vlax-curve-getPointAtDist en dist))
	  (progn
	    (command "_.BREAK" en pt pt)
	    (if (= i 1)
	      (entdel en))
	    (setq en (entlast)))))

      (setq name "zebra."
	    i 0)
      (while (setq enl (entnext enl))
	(ssadd enl ss))
      (while (tblsearch "BLOCK" (strcat name (itoa i))) (setq i (1+ i)))
      (command "_.-BLOCK" (strcat name (itoa i)) pt0 ss "")
      (command "_.-INSERT" (strcat name (itoa i)) pt0 1 "" "")
      (command "_.SETBYLAYER" "_l" "" "_N" "_Y")))
    
  (command "_.UCS" "_P")
  (foreach e oVAR (setvar (car e) (cdr e)))
  (vla-endundomark doc)
  (princ)
)

The one with contoures.

Spoiler

(vl-load-com)

(defun C:DashedAsBlockC ( / *error* _OffsetDouble oVAR doc 		;... with Contours
		       	    ensel en enc enl lenlin lengap lenl pt width dist ss name i)

  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (princ (strcat "\nError: " errmsg)))
    (foreach e oVAR (setvar (car e) (cdr e)))
    (vla-endundomark doc)
    (princ))

  ;Double Offset Method - CAB  10/26/2004
  (defun _OffsetDouble (ename dist / vobj enew)
    (setq vobj (vlax-ename->vla-object ename))
    (if (vlax-method-applicable-p vobj 'Offset)
      (progn
        (if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-invoke (list vobj 'Offset dist)))
          (prompt "\nPositive distance failed.")
          (setq enew (list (entlast))))
        (if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-invoke (list vobj 'Offset (- dist))))
          (prompt "\nNegative distance failed.")
          (setq enew (cons (entlast) enew))))
      (prompt "\nCannot offset selected object type.")))

  
  ;----- MAIN ROUTINE --------------------------------------------------------------------------
  (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
  (foreach e '(CMDECHO OSMODE ORTHOMODE CLAYER)
    (setq oVAR (cons (cons e (getvar e)) oVAR)))
  (setvar 'CMDECHO   0)
  (setvar 'ORTHOMODE 0)
  (setvar 'OSMODE    0)
  (command "_.UCS" "_W")
  
  (if (and (setq ensel (entsel "\nSelect a curve closer to its beginning: "))
	   (setq en (car ensel))
	   (wcmatch (cdr (assoc 0 (entget en))) "LWPOLYLINE,LINE,ARC")
	   (if (> (vlax-curve-getDistAtPoint en (vlax-curve-getClosestPointTo en (cadr ensel)))
		  (/ (vlax-curve-getDistAtPoint en (vlax-curve-getEndPoint en)) 2))
	     (if (eq (cdr (assoc 0 (entget en))) "ARC")
	       (princ "\nArc can't reverse. Linetype starts from the END!!!")
	       (progn
		 (command "_.REVERSE" en "")
		 (princ "\nCurve was reversed.")))
	     T)
	   (setvar 'CLAYER (cdr (assoc 8 (entget en))))
	   (not (command "_.CHPROP" en "" "_LA" "0" ""))
           (setq enl (entlast))
      )
    (progn
      (initget 6)
      (if (setq width (getreal "\nSet width <keep current>: "))
	(progn
	  (command "_.PEDIT" en "_W" width "")
	  (if (/= enl (entlast)) (setq enl (entlast) en enl)))
	(setq width (cdr (assoc 40 (entget en)))))
      (if (setq enc (_OffsetDouble en (/ width 2)))
	(foreach e enc (command "_.PEDIT" e "_W" 0 "")))
      (initget 6)
      (setq i (if (setq lenlin (getreal "\nSet length of LINE segments <start with a gap>: "))
		1
		0))
      (initget 6)
      (cond ((setq lengap (getreal (strcat "\nSet length of GAPs <" (if lenlin "equel to line" "1") ">: "))))
	    (T (setq lengap (cond (lenlin) (T 1)))))
      (if (and (not lenlin)
	       (not (initget 6))
	       (not (setq lenlin (getreal "\nSet length of LINE segments <equal to gap>: "))))
	(setq lenlin lengap))
      (setq pt0 (vlax-curve-getStartPoint en)
	    lenl (list lenlin lengap)
	    ss (ssadd))
      (if (= i 1) (ssadd en ss))
      (foreach e enc (ssadd e ss))

      (while (< (setq dist (nth (setq i (- 1 i)) lenl))
		(vlax-curve-getDistAtParam en (vlax-curve-getEndParam en)))
	(if (setq pt (vlax-curve-getPointAtDist en dist))
	  (progn
	    (command "_.BREAK" en pt pt)
	    (if (= i 1)
	      (entdel en))
	    (setq en (entlast)))))

      (setq name "zebra."
	    i 0)
      (while (setq enl (entnext enl))
	(ssadd enl ss))
      (while (tblsearch "BLOCK" (strcat name (itoa i))) (setq i (1+ i)))
      (command "_.-BLOCK" (strcat name (itoa i)) pt0 ss "")
      (command "_.-INSERT" (strcat name (itoa i)) pt0 1 "" "") 
      (command "_.SETBYLAYER" "_l" "" "_N" "_Y")))
    
  (command "_.UCS" "_P")
  (foreach e oVAR (setvar (car e) (cdr e)))
  (vla-endundomark doc)
  (princ)
)

I hope that helps.