Lisp routine for Section Mark

[matthewrussell]

Please see picture attached first.

 

Ok here it goes. I am trying to create a lisp routine that will work for that. What I am trying to do is make It out of 3 Blocks.

 

1st: Top Arrow and Top vertical line

2nd: Circle with horizontal line

3rd: Bottom arrow with bottom Vertical line

 

I am using AutoCAD 2009. So these blocks will be drawn at scale 1:1 but be made annotative when I block it. So when inserted say at 1:10 it will be at the correct sizing... (scales in metric system)

 

However Blocks 1 & 2 would be in the same DWG and block 3 will be in a second dwg. This is because I want 1 & 2 to clearly be inserted at the same co-ords in the drawing.

 

So that is what I am trying to do but this is what I am having trouble on.

 

Once I select the first point I want it to use like a ortho/polar thing from that first point. So that when the section mark is drawn in it will be aligned with the 2 points you selected. What is also giving me trouble is that how do I make it aligned and how do I make the arrows of the section be perpendicular to either side but you have to choose the direction they face. So if you draw the section horizontally and you wanted the section to look up vertically all you have to do is click to the top of the line u drew and the section arrows will face that way. And that applies if i clicked down i want the arrows to face down.

 

I know something like this is possible cause I have seen blocks like this in use. I am only a beginner at this lisp routine stuff so help will be greatly appreciated. Or if someone has already doen something like this can I possible get your coding so I can see how you did it.

 

I have also copied in some of the coding I have done for it.

 

(defun c:insert-secttop-block (/ layerset)

(setq layerset (getvar "clayer"))

(setvar "clayer" "35")

(setq scaleset (/1 (getvar "cannoscalevalue")))

(setvar "ATTDIA" 0)

;that last line is since I have attributed text in the block I dont want to eddit it now it will just go in as is.

(setq ins-pt (getpoint "\nSelect Insertion Point: "))

(if (=nil ins-pt) (setq ins-pt (list 0 0)))

 

That is it for the momment. But I think there is a easier way with the inserting points. Is there a way to name ins-pt1 and ins-pt2? So i can get those values and then just when I insert the block I can say for it to be inserted at variable ins-pt1???

 

Thanks for the help in advance

[russell84]

Post your 3 blocks and i'll give you a hand

[matthewrussell]

Ill put them up in a couple of minutes just putting the finishing touch on them.

[matthewrussell]

I have attached the DWG that has the blocks in it. All 3 blocks are there.

 

Thank you for your help

SECTION BUBBLE.dwg

[GAZZA]

Is the above avalible for all?

As I would find it very useful

[TimSpangler]

Why not a DB?

SectionCallout.dwg

[GhostRider]

Very cool Dynamic block, amazing what you can do with them, thanks TIM

[matthewrussell]

Dynamic blocks can do it, but it would not be as quick as a button whihc runs off the cannoscale(annotation scale).

 

Russell84 is this code relative to cannoscale or should I put that into it?

[matthewrussell]

I was using a line like

 

(setq scaleset(/ 1 (getvar "cannoscalevalue")))

 

In the lisp for the other blocks to scale them. And when I created the block I made it annotative.

 

Or is it possible to add this into it rather. So the dimscale is set from the cannoscale so the block will come in the correct size.

 

(setvar "DIMSCALE" (/ 1.0 (getvar "CANNOSCALEVALUE"))))

[GAZZA]

Tim

love the DB easy to use and its worked already.

Cheers

[matthewrussell]

For some reason when I run the command. It runs but just doesnt do anything. It doesnt come up with unknow command it just does nothing. Its puzzling me very much and Im trying to figure out why.

 

Could it have anything to do with the version of AutoCAD I am running? 2009

 

;---SECTION TITLE---

(defun c:insert-sectcall-block (/ layerset)

(setq layerset (getvar "clayer"))

(setvar "clayer" "35")

(setq scaleset(/ 1 (getvar "cannoscalevalue")))

(setvar "ATTDIA" 0)

(setq ins-pt (getpoint "\nSelect Insertion Point: "))

(if (= nil ins-pt) (setq ins-pt (list 805 553)) )

(command "-insert" "section title" ins-pt scaleset scaleset "0")

(command "explode" (entlast))

(setvar "ATTDIA" 1)

(setvar "clayer" layerset)

(princ)

) ;defun

 

That is the coding i was for my other blocks like the one shown in the jpg file.

 

This is what I did but I didnt know what to do for the ortho and the direction of the arrows.

 

;---SECTION BUBBLE---

(defun c:insert-sectbub-block (/ layerset)

(setq layerset (getvar "clayer"))

(setvar "clayer" "35")

(setq scaleset(/ 1 (getvar "cannoscalevalue")))

(setvar "ATTDIA" 0)

(setq ins-pt1 (getpoint "\nSelect First Insertion Point: "))

(if (= nil ins-pt1) (setq ins-pt1 (list 805 553)) )

(setq ins-pt2 (getpoint "\nSelect Second Insertion Point: "))

(if (= nil ins-pt2) (setq ins-pt2 (list 805 553)) )

(command "-insert" "section bubhead" ins-pt1 scaleset scaleset "0")

(command "-insert" "section bubarrow" ins-pt1 scaleset scaleset "0")

(command "-insert" "section bubtail" ins-pt2 scaleset scaleset "0")

(command "explode" (entlast))

(setvar "ATTDIA" 1)

(setvar "clayer" layerset)

(princ)

) ;defun

[russell84]

SORRY I LEFT A LITTLE BIT OUT.

 

Try this - let me know if it works.

 

 

 

(defun c:SECTMARK ()
(SETQ $PATH "C:/Documents and Settings/");CHANGE THIS TO THE PATH THAT YOU PASTE YOUR BLOCKS TO. CHEERS
(SE-erro)
(SE-quiet)
(SE-init)
(Get_mvs)
(pick1)
(ask1)
(setq #loc #org)  ;  ### Bubble Point
(make-pts1)
(setvar "attdia" 0)
(command
  "layer" "m" "TAGS" ""
  "insert" (strcat $PATH "Sec-ball") #loc DMS DMS "0" #sectno #drawno
  "insert" (strcat $PATH "Sec-arr")  #loc (* -1 DMS) DMS (rtd #ang)
); Arrow

(setvar "attdia" 1)
(setq TAIL "Sec-endB")
(setq MIR nil)
(setq MIR (getstring "\nFlip? Y/N <N>: "))
(if (/= MIR "")(setq MIR (strcase (substr MIR 1 1))))
(if (= MIR "Y")
(progn
(command "mirror" (entlast) "" #loc #2nd "y")
(setq TAIL "Sec-endA")))

(COMMAND "-INSERT" (strcat $PATH TAIL) "_r" (rtd (+ (* pi (/ 180 180)) #ang)) "_s" DMS #LOC )
(COMMAND "UCS" "Z" (RTD #ANG))
(SETVAR "ORTHOMODE" 1)
(princ "\nSelect base point to move section tail from..")
(COMMAND "MOVE" (ENTLAST) "" pause PAUSE)
(COMMAND "UCS" "P")

(SE-normal)
(setq *error* olderror)
(princ)
)
(defun dtr (a)
  (* pi (/ a 180.0))
)
(defun rtd (a)
  (* 180.0 (/ a pi))
)
(defun SE-init ()
(setq #45  (dtr 45)
     #90  (dtr 90)
     #135 (dtr 135)
     #180 (dtr 180)
     #225 (dtr 225)
     #270 (dtr 270)
     #315 (dtr 315)
)
)

(defun pick1 ()
(setq #org nil #2nd nil #side nil)
(while (= #org nil)
  (setq #org (getpoint "\nSelect Center point of Section Bubble: "))
)
(while (= #2nd nil)
  (setq #2nd (getpoint #org "\nRotation of Section mark?: "))
  (if (= (getvar "orthomode") 0)
     (setq orno T)
     (setq orno nil)
  )
)
(setq #ang (angle #org #2nd))
(setq #dist (distance #org #2nd))
)

(DEFUN Get_mvs ()
(if (and (= (getvar "cvport") 1)(= (getvar "tilemode") 0)) ; if in Paperspace
  (setq dms 1)
  (if  (= (getvar "tilemode") 0) ; if in Modelspace inside viewport
     (progn
        (vscl)
        (setq dms mvs)
     );progn
     (Try_Dimscale)
  );if
);if
);defun

(defun ask1 ()
(if #sectno
  (progn
     (setq #prevno #sectno)
     (setq #sectno (getstring (strcat "\nSection Number <" #prevno ">: ")))
     (if (= #sectno "")(setq #sectno #prevno))
  )
  (progn
     (setq #sectno (getstring "\nSection Number <1>: "))
     (if (= #sectno "") (setq #sectno "1"))
)
)
(if #drawno
  (progn
     (setq #prevdrawno #drawno)
     (setq #drawno (getstring (strcat "\nDrawing Reference <" #prevdrawno ">: ")))
     (if (= #drawno "")(setq #drawno #prevdrawno))
  )
  (progn
     (setq #drawno (getstring "\nDrawing Reference <->: "))
     (if (= #drawno "") (setq #drawno "-"))
  )
)
)

(defun make-pts1 ()
(setq #bb1  (polar #loc  (+ #ang #180) (* DMS 17.0)));; Bubble Centre
(setq #tp2  (polar #loc (+ #ang #90)  (* DMS 15.0))) ;; Text Left
(setq #tp1  (polar #2nd (+ #ang #90)  (* DMS 15.0))) ;; Text right
(cond
( (= #90 #ang)(setq #tang 0) )
( (= #270 #ang)(setq #tang 0) )
( (and (< #90 #ang)(> #270 #ang) )(setq #tang (+ #180 #ang)) )
( t (setq #tang #ang) )
);cond
)

(defun SE-quiet ()
(setvar "cmdecho"   0)
(setq OLDOSMODE (getvar "osmode"))
(setvar "osmode" 0)
(COMMAND "UNDO" "GROUP")
(setq angb   (getvar "angbase")
     angd   (getvar "angdir")
     orthom (getvar "orthomode")
     blipm  (getvar "blipmode")
)
(setvar "plinewid"  0)
(setvar "blipmode"  0)
(setvar "angbase"   0)
(setvar "angdir"    0)
(if orno (setvar "orthomode" 0)
        (setvar "orthomode" 1)
)
(CURRENT_COLOR)
(setq #CLA (getvar "clayer"))
(setq #CLT (getvar "celtype"))
(command "color" "bylayer")
(command "linetype" "s" "bylayer" "")
(command "layer" "m" "TAGS" "")
)
;;; Reset Values
(defun SE-normal ()
(if blipm   (setvar "blipmode"  blipm))
(if angb    (setvar "angbase"   angb))
(if angd    (setvar "angdir"    angd))
(if orthom  (setvar "orthomode" orthom))
(command "layer" "s" #CLA "")
(command "color" #CCN)
(command "linetype"  "s" #CLT "")
(COMMAND "UNDO" "END")
(setvar "cmdecho"   1)
(setvar "osmode" oldosmode)
)
(defun SE-erro () (setq olderr *error* *error* SEerra))
(defun SEerra (s)                            ; If an error (such as CTRL-C) occurs
                                          ; while this command is active...
  (if (/= s "Function cancelled")
     (princ (strcat "\nError: " s))
  )
  (if blipm   (setvar "blipmode"  blipm))
  (if angb    (setvar "angbase"   angb))
  (if angd    (setvar "angdir"    angd))
  (if orthom  (setvar "orthomode" orthom))
  (if #CLA    (command "layer" "s" #CLA ""))
  (if #CCN    (command "color" #CCN))
  (if #CLT    (command "linetype" "s" #CLT ""))
  (COMMAND "UNDO" "END")
  (setvar "cmdecho" 1)
  (setvar "osmode" oldosmode)
  (setq *error* olderr)                   ; restore old *error* handler
  (princ)
)
(defun CURRENT_COLOR ()
  (setq #CCN (getvar "cecolor"))
  (if (or (= #CCN "BYBLOCK")(= #CCN "BYLAYER"))
     (setq #cn #CCN)
     (progn
        (setq #cr (atoi #CCN))
        (if (and (> #cr 0) (< #cr )
           (progn
              (setq #CLIST (list "RED" "YELLOW" "GREEN" "CYAN" "BLUE" "MAGENTA" "WHITE"))
              (setq #cn (nth (- #cr 1) #CLIST))
           )
           (setq #cn (rtos #cr 2 0))
        )
     )
  )
)

(defun Try_Dimscale ()
(if (or (= (getvar "Dimscale") 0)(= (getvar "Dimscale") 1))
  (progn
     (initget 1)
     (setq dms (getint "\nEnter SCALE: "))
  )
  (setq dms (getvar "Dimscale"))
);if
);defun

[russell84]

By the wall matthew on cad tutor wrap all your code between "code" tags.

 

Push the # button when posting - then paste your code between the two sets of brackets to do this.

[matthewrussell]

Russell, it works till It comes to this part.

 

Command:  INSERT-SECTMARK-BLOCK
Enter SCALE: 1
Select Center point of Section Bubble:
Rotation of Section mark?:
Section Number <1>: 1
Drawing Reference <2>: 2
"PersonalCADSUPPORTSec-ball.dwg": Can't find file in search path:
 C:\Documents and Settings\matthew.russell\My Documents\ (current directory)
 D:\Personal\CAD\Support\
 D:\Personal\CAD\MENU\
 D:\Personal\CAD\MENU\ICONS\
 C:\sp2000\
 X:\Acad\Support\Brisbane\Linetypes\
 X:\Acad\Support\Brisbane\Fonts\
 C:\Documents and Settings\matthew.russell\Application Data\Autodesk\AutoCAD 
2009\R17.2\enu\support\
 C:\Program Files\AutoCAD 2009\support\
 C:\Program Files\AutoCAD 2009\fonts\
 C:\Program Files\AutoCAD 2009\help\
 C:\Program Files\AutoCAD 2009\express\
 C:\Program Files\AutoCAD 2009\drv\
 C:\Program Files\AutoCAD 2009\
*Invalid*

 

I stored the dwgs you gave me in D:\Personal\CAD so then in the code i added (SETQ $PATH "D:\Personal\CAD") where you put the note.

 

Instead of having to enter the scale how could i change that part so It will get the scale automatically

[russell84]

SCALE works fine here.

 

change the scale around to say 1:500 1:100 and see if you still have the problem.

 

also change

 (SETQ $PATH "D:\Personal\CAD") 

 

to

  (SETQ $PATH "D:/Personal/CAD/") 

 

Then see how you go.

 

See if that works for you and let me know

[matthewrussell]

I have changed the code to what you said but for some reason now. I have the .lsp file loaded and I type in the command but for some reason it says that it is not a command. This is really quite puzzling. Did you teach yourself about coding like this?

 

What I was thinking of doing to this code was to change this to

(defun Try_Dimscale ()
(if (or (= (getvar "Dimscale") 0)(= (getvar "Dimscale") 1))
  (progn
     (initget 1)
     (setq dms (getint "\nEnter SCALE: "))
  )
  (setq dms (getvar "Dimscale"))
);if
);defun

 

to

 

(defun Try_Dimscale ()
(setvar "DIMSCALE" (/ 1.0 (getvar "CANNOSCALEVALUE"))))
);defun

 

just so what ever scale I have set it will automatically get it and insert the section mark in that scale. What do you think will that work?

[matthewrussell]

I got it to load I just forgot to reload the application. But the file location still is not working. I was think to just place it in my document on c drive. As in the location it was original looking for because when the error comes up underneath of it saying it cant be found it has this "C:\Documents and Settings\matthew.russell\My Documents\ (current directory)" so im thinking there may be something there that is making the command still search there for some unknown reason

[russell84]

matthew post the code that shows what you have the $PATH set as

[matthewrussell]

(SETQ $PATH "D:\Personal\CAD\Support\")

 

The lisp file is in the support folder so is the dwg files

[russell84]

So this is the location that the blocks are kept?

 

Please change this code to

(SETQ $PATH "D:/Personal/CAD/Support/")

 

You have to reverse the "\" within lisp.

 

please let me know how you go ok