Lisp Help

[neekcotrack]

Does anyone know of a lisp that can do this:

 

1. Type the command

2. Ask for text hieght

3. Ask for point on arc ( Call this P1).

4. Make the angle of the text = Perpendicular to (The line from P1 to the center of arc)

 

5. Make a box around the text ( make box 1.5 bigger all around text)

6. trim arc inside box

7. delete box

8. End of command.

 

Thanks in advance for your help I hope someone can lead me in the right direction.

[Adesu]

Do you mean like this and I hpe you should you continous.

(defun c:test(/)
 (setq hei (getdist "\nEnter new text height: "))
 (setq p1 (entsel "\nPick any location in arc object"))
 (setq ent (car p1))
 (setq sse (entget ent))
 (setq bp (cdr (assoc 10 sse)))
 (setq pt (cadr p1))
 (setq ang (angle pt bp))
 5. Make a box around the text ( make box 1.5 bigger all around text)
 6. trim arc inside box
 7. delete box
 8. End of command.
 (princ)
 ) ; defun

 

Does anyone know of a lisp that can do this:

 

1. Type the command

2. Ask for text hieght

3. Ask for point on arc ( Call this P1).

4. Make the angle of the text = Perpendicular to (The line from P1 to the center of arc)

 

5. Make a box around the text ( make box 1.5 bigger all around text)

6. trim arc inside box

7. delete box

8. End of command.

 

Thanks in advance for your help I hope someone can lead me in the right direction.

[neekcotrack]

Do you mean like this and I hpe you should you continous.

(defun c:test(/)
 (setq hei (getdist "\nEnter new text height: "))
 (setq p1 (entsel "\nPick any location in arc object"))
 (setq ent (car p1))
 (setq sse (entget ent))
 (setq bp (cdr (assoc 10 sse)))
 (setq pt (cadr p1))
 (setq ang (angle pt bp))
 5. Make a box around the text ( make box 1.5 bigger all around text)
 6. trim arc inside box
 7. delete box
 8. End of command.
 (princ)
 ) ; defun

 

Does anyone know how to aquire steps 5 through 8? Thanks in advance to you for anything.

[VovKa]

why trim? why not wipout or mtext's backgroung mask?

[neekcotrack]

why trim? why not wipout or mtext's backgroung mask?

 

I don't want to use background mask cause I don't want it to take away from the detail behind, and wipeout I don't know what that it. All I am trying to do is make the arc be trimmed back a little on both sides of the E.

[VovKa]

(vl-load-com)
(defun C:Test (/ ActiveDocObj  Ent
		       EntName	     EntObj
		       InsParam	     InsPoint
		       Temp	     TextAngle
		       TextBoxCoords TextBoxWidth
		       TextHeight    TextString TextOffset TextWidth
		      )
 (setq	TextHeight 5.0
TextOffset 1.0
TextString "///"
TextWidth 0.4
 )
 (setq ActiveDocObj (vla-get-activedocument (vlax-get-acad-object)))
 (vla-EndUndoMark ActiveDocObj)
 (while (and (setq Ent (entsel)))
   (setq EntName (car Ent))
   (if
     (and (wcmatch (vla-get-ObjectName
	      (setq EntObj (vlax-ename->vla-object EntName))
	    )
	    "AcDbLine,AcDbPolyline,AcDbArc,AcDbCircle"
   )
   (setq InsPoint (vlax-curve-getClosestPointTo EntObj (cadr Ent)))
   (setq InsParam (vlax-curve-getParamAtPoint EntObj InsPoint))
     )
      (progn
 (setq TextAngle
	((lambda (d)
	   (if (zerop (cadr d))
	     (/ pi 2)
	     (atan (apply '/ d))
	   )
	 )
	  (cdr (reverse
		 (vlax-curve-getFirstDeriv EntObj InsParam)
	       )
	  )
	)
 )
 (setq TextBoxCoords
	(textbox (setq Temp (list (cons 0 "TEXT")
				  (cons 1 TextString)
				  (cons 40 TextHeight)
				  (cons 10 InsPoint)
				  (cons 11 InsPoint)
				  (cons 41 TextWidth)
				  (cons 50 TextAngle)
				  (cons 72 1)
				  (cons 73 2)
			    )
		 )
	)
 )
 (setq TextBoxWidth
	(apply '- (reverse (mapcar 'car TextBoxCoords)))
 )
 (vla-startundomark ActiveDocObj)
 (progn
   (entmake Temp)
   (vl-cmdf
     "._BREAK"
     (list
       EntName
       (trans (vlax-curve-getPointAtDist
		EntObj
		(- (setq
		     Temp (vlax-curve-getDistAtParam EntObj InsParam)
		   )
		   (/ TextBoxWidth 2.0)
		   TextOffset
		)
	      )
	      0
	      1
       )
     )
     (trans (vlax-curve-getPointAtDist
	      EntObj
	      (+ Temp (/ TextBoxWidth 2.0) TextOffset)
	    )
	    0
	    1
     )
   )
 )
 (vla-endundomark ActiveDocObj)
      )
   )
 )
 (princ)
)

[neekcotrack]

Thank you that was perfect. Can I ask one more favor. Is it possible to take the code you have above and make it use /// instead of E. Can it have a .4 Width factor. Plus I don't need the box breaking the arc. Thanks for everything wish I could help you. I guess in time I will get better at this stuff.

[VovKa]

i just use break instead of trim, and the result is the same, does this matter?

i edited my previous post to support width factor

[neekcotrack]

i just use break instead of trim, and the result is the same, does this matter?

i edited my previous post to support width factor

 

Nope the one you did was perfect just what I was looking for. Thanks so much you helped me a lot.

 

Just one question if I want to make a lisp that calls up another lisp how would I do that?Would this work?

 

(defun c:test ()

((load "test") "" test "")))

[neekcotrack]

Last thing how would I take out the part so it dont break the arc?

[VovKa]

this one will not break anything

(vl-load-com)
(defun C:Test (/	     ActiveDocObj  Ent		 EntName
       EntObj	     InsParam	   InsPoint	 Temp
       TextAngle     TextBoxCoords TextBoxWidth	 TextHeight
       TextString    TextOffset	   TextWidth
      )
 (setq	TextHeight 5.0
TextOffset 1.0
TextString "///"
TextWidth 0.4
 )
 (setq ActiveDocObj (vla-get-activedocument (vlax-get-acad-object)))
 (vla-EndUndoMark ActiveDocObj)
 (while (and (setq Ent (entsel)))
   (setq EntName (car Ent))
   (if
     (and (wcmatch (vla-get-ObjectName
	      (setq EntObj (vlax-ename->vla-object EntName))
	    )
	    "AcDbLine,AcDbPolyline,AcDbArc,AcDbCircle"
   )
   (setq InsPoint (vlax-curve-getClosestPointTo EntObj (cadr Ent)))
   (setq InsParam (vlax-curve-getParamAtPoint EntObj InsPoint))
     )
      (progn
 (setq TextAngle
	((lambda (d)
	   (if (zerop (cadr d))
	     (/ pi 2)
	     (atan (apply '/ d))
	   )
	 )
	  (cdr (reverse
		 (vlax-curve-getFirstDeriv EntObj InsParam)
	       )
	  )
	)
 )
 (vla-startundomark ActiveDocObj)
 (entmake (list	(cons 0 "TEXT")
		(cons 1 TextString)
		(cons 40 TextHeight)
		(cons 10 InsPoint)
		(cons 11 InsPoint)
		(cons 41 TextWidth)
		(cons 50 TextAngle)
		(cons 72 1)
		(cons 73 2)
	  )
 )
 (vla-endundomark ActiveDocObj)
      )
   )
 )
 (princ)
)

if you want to call it from another lisp, use (c:test)

[neekcotrack]

Thanks Ill try it in the morning!

[neekcotrack]

Is there a way to take your last lisp the one that does not break, and Have it ask how many tic? [3],[4],[5],[6],[7],[8],[9]. For what ever number you pick it puts /// for [3], //// for [4], ///// for [5]..ect... It be putting the /// in the text part. Cause I can you the last thing you sent but I would have to change the text part in for each one and I would have 7 lisp for the tics alone and One master that would call up the lisp depending if its 3,4,5...etc... Thanks in advance for all you help so for and any future help.

[VovKa]

there you go

(vl-load-com)
(defun C:Test (/ ActiveDocObj Ent	   EntName	EntObj
	 InsParam     InsPoint	   Temp		TextAngle
	 TextHeight   TextString   TextWidth
	)
 (setq	TextHeight 5.0
TextString ""
TextWidth 0.4
 )
 (repeat (progn (initget 7) (getint "\nNumber of tics: "))
   (setq TextString (strcat TextString "/"))
 )
 (setq ActiveDocObj (vla-get-activedocument (vlax-get-acad-object)))
 (vla-EndUndoMark ActiveDocObj)
 (while (and (setq Ent (entsel)))
   (setq EntName (car Ent))
   (if
     (and (wcmatch (vla-get-ObjectName
	      (setq EntObj (vlax-ename->vla-object EntName))
	    )
	    "AcDbLine,AcDbPolyline,AcDbArc,AcDbCircle"
   )
   (setq InsPoint (vlax-curve-getClosestPointTo EntObj (cadr Ent)))
   (setq InsParam (vlax-curve-getParamAtPoint EntObj InsPoint))
     )
      (progn
 (setq TextAngle
	((lambda (d)
	   (if (zerop (cadr d))
	     (/ pi 2)
	     (atan (apply '/ d))
	   )
	 )
	  (cdr (reverse
		 (vlax-curve-getFirstDeriv EntObj InsParam)
	       )
	  )
	)
 )
 (vla-startundomark ActiveDocObj)
 (entmake (list	(cons 0 "TEXT")
		(cons 1 TextString)
		(cons 40 TextHeight)
		(cons 10 InsPoint)
		(cons 11 InsPoint)
		(cons 41 TextWidth)
		(cons 50 TextAngle)
		(cons 72 1)
		(cons 73 2)
	  )
 )
 (vla-endundomark ActiveDocObj)
      )
   )
 )
 (princ)
)

[neekcotrack]

Vovka,

 

I need to tak this lisp one step further. Can I make a text style called tic and make it romans and make the text 10, then put the tics on that layer. Is that possible.

[VovKa]

(vl-load-com)
(defun C:Test (/
       ActiveDocObj
       Ent
       EntName
       EntObj
       InsParam
       InsPoint
       Temp
       TextAngle
       TextHeight
       TextString
       TextWidth
       TextStyle
       TextLayer
      )
 (setq	TextHeight 10.0
TextString ""
TextWidth 0.4
TextStyle "Tics"
TextLayer "Wires"
 )
 (if (not (tblsearch "LAYER" TextLayer))
   (entmake (list (cons 0 "LAYER")
	   (cons 100 "AcDbSymbolTableRecord")
	   (cons 100 "AcDbLayerTableRecord")
	   (cons 2 TextLayer)
	   (cons 62 11)
	   (cons 70 0)
     )
   )
 )
 (if (not (tblsearch "STYLE" TextStyle))
   (entmake (list (cons 0 "STYLE")
	   (cons 100 "AcDbSymbolTableRecord")
	   (cons 100 "AcDbTextStyleTableRecord")
	   (cons 2 TextStyle)
	   (cons 70 0)
	   (cons 40 TextHeight)
	   (cons 41 1.0)
	   (cons 50 0.0)
	   (cons 71 0)
	   (cons 42 TextHeight)
	   (cons 3 "Write your font name here")
;;;		   (cons 3 "isocpeur.ttf")
	   (cons 4 "")
     )
   )
 )
 (repeat (progn (initget 7) (getint "\nNumber of tics: "))
   (setq TextString (strcat TextString "/"))
 )
 (setq ActiveDocObj (vla-get-activedocument (vlax-get-acad-object)))
 (vla-EndUndoMark ActiveDocObj)
 (while (and (setq Ent (entsel)))
   (setq EntName (car Ent))
   (if
     (and (wcmatch (vla-get-ObjectName
	      (setq EntObj (vlax-ename->vla-object EntName))
	    )
	    "AcDbLine,AcDbPolyline,AcDbArc,AcDbCircle"
   )
   (setq InsPoint (vlax-curve-getClosestPointTo EntObj (cadr Ent)))
   (setq InsParam (vlax-curve-getParamAtPoint EntObj InsPoint))
     )
      (progn (setq TextAngle
	     ((lambda (d)
		(if (zerop (cadr d))
		  (/ pi 2)
		  (atan (apply '/ d))
		)
	      )
	       (cdr (reverse
		      (vlax-curve-getFirstDeriv EntObj InsParam)
		    )
	       )
	     )
      )
      (vla-startundomark ActiveDocObj)
      (entmake (list (cons 0 "TEXT")
		     (cons 7 TextStyle)
		     (cons 8 TextLayer)
		     (cons 1 TextString)
		     (cons 40 TextHeight)
		     (cons 10 InsPoint)
		     (cons 11 InsPoint)
		     (cons 41 TextWidth)
		     (cons 50 TextAngle)
		     (cons 72 1)
		     (cons 73 2)
	       )
      )
      (vla-endundomark ActiveDocObj)
      )
   )
 )
 (princ)
)

[neekcotrack]

Is there any way to make the layer Wires and put it on color 11? This is the layer I want the tics on.

 

Thanks,

[VovKa]

ok, i edited my previous post