Topic: simple lisp routine

[CADEC70]

Hi All,
I know this is easy to do, if you're a 'lisp jedi'..
is anybody out there who can help me and make this a reality.
help is greatly appreciated.
thanks in advance

[Guest]

What's the deal with the green lines?  Is the angle between the two points always going to be 143??

[ronjonp]

Here is something to get you going.....will work if your block insertion is centered.

Code: [Select]

(defun c:sumtin (/ pt1 pt2 pt3 pt4 pt5)
  (if (setq pt1 (getpoint "\n Pick first point: ")
    pt2 (getpoint "\n Pick second point: ")
    pt3 (getpoint "\n Pick block location: ")
      )
    (progn
      (setq pt4 (polar pt3 (angle pt3 pt1) 24)
    pt5 (polar pt3 (angle pt3 pt2) 24)
      )
      (addline "line" pt1 pt4)
      (addline "line" pt2 pt5)
      (insertblock "MYBLK" pt3 1.0 1.0 0.0)
    )
  )
)

(defun addline (lyr spt ept /)
  (entmakex
    (list '(0 . "LINE")
  '(100 . "AcDbEntity")
  (cons 8 lyr)
  '(100 . "AcDbLine")
  (cons 10 spt)
  (cons 11 ept)
    )
  )
)

(defun insertblock (name pt xsc ysc rot / doc)
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (vla-insertblock
    (if (= (getvar 'cvport) 1)
      (vla-get-paperspace doc)
      (vla-get-modelspace doc)
    )
    (vlax-3d-point (trans pt 1 0))
    name
    xsc
    ysc
    xsc
    rot
  )
)

[CADEC70]

What's the deal with the green lines?  Is the angle between the two points always going to be 143??

The green line..represents a wall..so angle could varies.
What it is..is that 'm doing an elevation of a wall, by doing so I need to call it out.
It would e easier if I have a lisp function as shown on my attachment.

[CADEC70]

Thanks Ron,
This is great!
I'm not a lisp guy..how do you add a block at the end of the lines? And I also need it to automatically edit its text attributes..please help if you dont mind.

thank you

Here is something to get you going.....will work if your block insertion is centered.

Code: [Select]

(defun c:sumtin (/ pt1 pt2 pt3 pt4 pt5)
  (if (setq pt1 (getpoint "\n Pick first point: ")
    pt2 (getpoint "\n Pick second point: ")
    pt3 (getpoint "\n Pick block location: ")
      )
    (progn
      (setq pt4 (polar pt3 (angle pt3 pt1) 24)
    pt5 (polar pt3 (angle pt3 pt2) 24)
      )
      (addline "line" pt1 pt4)
      (addline "line" pt2 pt5)
      (insertblock "MYBLK" pt3 1.0 1.0 0.0)
    )
  )
)

(defun addline (lyr spt ept /)
  (entmakex
    (list '(0 . "LINE")
  '(100 . "AcDbEntity")
  (cons 8 lyr)
  '(100 . "AcDbLine")
  (cons 10 spt)
  (cons 11 ept)
    )
  )
)

(defun insertblock (name pt xsc ysc rot / doc)
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (vla-insertblock
    (if (= (getvar 'cvport) 1)
      (vla-get-paperspace doc)
      (vla-get-modelspace doc)
    )
    (vlax-3d-point (trans pt 1 0))
    name
    xsc
    ysc
    xsc
    rot
  )
)

[CAB]

This does add the block (insertblock "MYBLK" pt3 1.0 1.0 0.0)
just change the name "MYBLK" to your block name.
If you want to edit the attributes, you can try replaceing that line with this
(initdia)(command "_insert")

gotta run, sorry..

[CADEC70]

thank you
I didn't get the 'edit attribures' part. I tried doing it but it doesn't work.
And it is also possible that the two lines automatically be the same layer as my block..
(I mean like when youre doing dimensions, whatever yur current layer is that would be youre layer when do yur dims)

thanks

[CAB]

Give this a try.
When you use the command to insert a block with attributes you must address the following system variables.

Code: [Select]

;|
ATTDIA
Controls whether the -INSERT command uses a dialog box for attribute value entry. See "INSERT Command Line."
0        Issues prompts on the command line
1        Uses a dialog box

ATTMODE
Controls display of attributes.
0        Off: Makes all attributes invisible
1        Normal: Retains current visibility of each attribute: visible attributes are
                displayed; invisible attributes are not
2        On: Makes all attributes visible

ATTREQ
Determines whether the INSERT command uses default attribute settings during insertion of blocks.
0        Assumes the defaults for the values of all attributes
1        Turns on prompts or dialog box for attribute values, as specified by ATTDIA

TEXTEVAL
Controls the method of evaluation of text strings.
0        All responses to prompts for text strings and attribute values are taken literally
1        Text starting with an opening parenthesis [ ( ] or an exclamation mark (!) is
            evaluated as an AutoLISP expression, as for nontextual input
|;

(defun c:sumtin (/ pt1 pt2 pt3 pt4 pt5)
  (if (setq pt1 (getpoint "\n Pick first point: ")
            pt2 (getpoint "\n Pick second point: ")
            pt3 (getpoint "\n Pick block location: ")
      )
    (progn
      (setq pt4 (polar pt3 (angle pt3 pt1) 24)
            pt5 (polar pt3 (angle pt3 pt2) 24)
      )
      (addline "line" pt1 pt4)
      (addline "line" pt2 pt5)
      (insertblock "MYBLK" pt3 1.0 1.0 0.0)
    )
  )
)

(defun addline (lyr spt ept /)
  (entmakex
    (list '(0 . "LINE")
          '(100 . "AcDbEntity")
          (cons 8 lyr)
          '(100 . "AcDbLine")
          (cons 10 spt)
          (cons 11 ept)
    )
  )
)

(defun insertblock (name pt xsc ysc rot /
                    syscmdecho sysattdia sysattreq systxteva)
  (setq syscmdecho (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setq sysattdia (getvar "ATTDIA"))
  (setq sysattreq (getvar "ATTREQ"))
  (setq systxteva (getvar "TEXTEVAL"))
  (setvar "ATTDIA" 1)
  (setvar "ATTREQ" 1)
  (setvar "TEXTEVAL" 0)
  (initdia) ; force dialog ON
  ;;  -insert uses the - to spress the dialog for the insertion
  (command ".-insert" "MYBLK" "_non" pt xsc ysc rot)

  (setvar "ATTDIA" sysattdia)
  (setvar "ATTREQ" sysattreq)
  (setvar "TEXTEVAL" systxteva)
  (setvar "CMDECHO" syscmdecho)
  (princ)
)

[CADEC70]

Thanks
Just one more request..
the two lines, is on 'line' layer..is there a way to change that automatically to be the same layer of my block or my current layer?

[CAB]

Remove (cons 8 lyr) and the current layer will be used.

Or use

(addline (getvar "CLAYER") pt1 pt4)

[CADEC70]

Thanks..this is great!
really appreciate the help
say what if, you want to have an arc instead of lines..is that possible too..if yes how do you do it?
Thanks again

[CAB]

The arc can be a little tricky

Code: [Select]

(entmake (list (cons 0 "ARC") ;***
               (cons 6 "BYLAYER")
               (cons 8 "0") ; layer
               (cons 10 (list 0.0 0.0 0.0)) ;*** Center point (in OCS)
               (cons 39 0.0) ; Thickness (optional; default = 0)
               (cons 40 1.0) ;*** Radius
               (cons 50 0.0) ;*** Start angle
               (cons 51 1.57079633) ;*** End angle
               )) ; Extrusion direction. (optional; default = 0, 0, 1)

Here is an old routine that uses an arc.

Code: [Select]

;;;   By Charles Alan Butler  : Last Modified 03/25/05
;;;   ArcL.lsp    (Arc Leader)
;;;   Uses the current layer & MyArrow Arrow head

;;;======  Main Lisp Routine  =======
(defun c:ArcL (/  usercmd useros userAngDir loop ptpick Lastpt makeMyblk
                  ArcC arcArw *error*)

  ;; error function & Routine Exit
  (defun *error* (msg)
    (if
      (not
(member
  msg
  '("console break" "Function cancelled" "quit / exit abort" "")
)
      )
       (princ (strcat "\nError: " msg))
    )
    (setvar "osmode" useros)
    (setvar "CMDECHO" usercmd)
    (setvar "angdir" userangdir)
    (princ)
  )
 ;end error function

;;;=============================================================
;;;              Local Functions
;;;=============================================================
  (defun makeMyblk (/ ss)
    ;;  NOTE arrow is 45deg rotated
    (command "-color" "Red")
    (command "line" "0,0" "0,6" "")
    (setq ss (ssadd))
    (ssadd (entlast) ss)
    (command "line" "0,0" "6,0" "")
    (ssadd (entlast) ss)
    (command "line" "0,0" (polar '(0 0) 0.2618 6) "")
    (ssadd (entlast) ss)
    (command "line" "0,0" (polar '(0 0) 1.309 6) "")
    (ssadd (entlast) ss)
    (command "-block" "MyArrow" '(0 0) ss "")
    (command "-color" "ByLayer")
  ) ;defun
 
;;;=============================================
;;;   ArcC    Arc Leader with Circle Arrow Head
;;;   Uses the current layer & Circle Arrow head
;;;=============================================

(defun ArcC (/ ArcEnt)
  (setq ArcEnt (list (entlast) ptpick))
  (Command "_.Circle" ptpick 2) ; circle arrow head 2" radius
  (command "_trim" (entlast) "" ArcEnt "")
) ;  end defun

;;;=============================================
;;;   ArcArw    Arc Leader with Arrow Type Head
;;;   Uses the current layer & Block Arrow head
;;;=============================================

(defun arcArw (ptpick / L_Angle cenpt    rad      StartAng  arcdata
       EndAng ArwOffset
      )
  (vl-load-com)
  (setq arwsize 6)
      (setq vobj (vlax-ename->vla-object (entlast)))
      (setq stpt (trans (vlax-curve-getstartpoint vobj) 0 1))
      (setq enpt (trans (vlax-curve-getendpoint vobj)0 1))
      (setq len  (vlax-curve-getdistatparam vobj (vlax-curve-getendparam vobj)))
      (if (< (distance stpt ptpick) (distance enpt ptpick))
        (setq dist arwsize)
        (setq dist (- len arwsize)
              enpt stpt)
      )
      (setq p1 (trans (vlax-curve-getpointatdist vobj dist) 0 1)) ; UCS to WCS ; end of arrow
      (setq ang (- (* 180.0 (/ (angle ptpick p1) pi)) 45))
      (setvar "osmode" 0)
      ;; ----------   Arrow Head    ---------------
      (if (not (tblsearch "block" "MyArrow"))
        (MakeMyBlk)
      )
      (command "_.insert" "MyArrow" ptpick "" "" ang)
); end defun

;;;=============================================================
;;;=============================================================
;;;          Routine Starts Here
;;;=============================================================
;;;=============================================================
  (princ "\n")
  (princ "\n            Arc Leader - Version 1.3")
  (princ "\n")

;;; -------  Some Housekeeping   ------------------
  (setq usercmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setq useros (getvar "osmode"))
  (setvar "osmode" 0)
  (setq userANGDIR (getvar "angdir"))
  (setvar "angdir" 0)
  (if (not ArType) ; Set Arrow Type FOR THE FIRST TIME IN THE ROUTINE
      (setq ArType "Arrow")
  ) ; endif


  ;;  loop until user enters point or "C" or "A"
  (setq loop T)
  (while loop
    (initget 1 "Circle Arrow")
    (setq
      ptpick (getpoint
       (strcat "\nPick leader start point or [Circle / Arrow]:<" ArType ">"))
    )
    (cond
      ((= (type ptpick) 'LIST) ; point picked
       (setq loop nil) ; exit loop
      )
      ((or (= ptpick "Circle") (= ptpick "Arrow"))
       (setq ArType ptpick)
      )
      (T (alert "Pick point or enter C or A"))
    )
  ) ; end while

  (command "arc" ptpick pause pause)
  (if (= "ARC" (cdr (assoc 0 (entget (entlast)))))
    (progn ; arc created
      (setq Lastpt (getvar "lastpoint"))
      (cond
((= ArType "Arrow")
(ArcArw ptpick)
)
((= ArType "Circle")
(ArcC)
)
      )
    )
  ) ; endif

;;;==========  Exit Sequence  ============
  (*error* "")
  (princ)
  (list ptpick Lastpt) ; return the start & end point of the arc
) ;  end defun
(prompt "\nArc Leader Loaded, Type  ArcL  to run")
(princ)

;;;==========  End of Routine  ============

;;;/////////////
;;;    EOF
;;;\\\\\\\\\\\\\

[CADEC70]

Sorry

how do you add this function to the last one that I got?

thanks in advance

The arc can be a little tricky

Code: [Select]

(entmake (list (cons 0 "ARC") ;***
               (cons 6 "BYLAYER")
               (cons 8 "0") ; layer
               (cons 10 (list 0.0 0.0 0.0)) ;*** Center point (in OCS)
               (cons 39 0.0) ; Thickness (optional; default = 0)
               (cons 40 1.0) ;*** Radius
               (cons 50 0.0) ;*** Start angle
               (cons 51 1.57079633) ;*** End angle
               )) ; Extrusion direction. (optional; default = 0, 0, 1)

Here is an old routine that uses an arc.

Code: [Select]

;;;   By Charles Alan Butler  : Last Modified 03/25/05
;;;   ArcL.lsp    (Arc Leader)
;;;   Uses the current layer & MyArrow Arrow head

;;;======  Main Lisp Routine  =======
(defun c:ArcL (/  usercmd useros userAngDir loop ptpick Lastpt makeMyblk
                  ArcC arcArw *error*)

  ;; error function & Routine Exit
  (defun *error* (msg)
    (if
      (not
(member
  msg
  '("console break" "Function cancelled" "quit / exit abort" "")
)
      )
       (princ (strcat "\nError: " msg))
    )
    (setvar "osmode" useros)
    (setvar "CMDECHO" usercmd)
    (setvar "angdir" userangdir)
    (princ)
  )
 ;end error function

;;;=============================================================
;;;              Local Functions
;;;=============================================================
  (defun makeMyblk (/ ss)
    ;;  NOTE arrow is 45deg rotated
    (command "-color" "Red")
    (command "line" "0,0" "0,6" "")
    (setq ss (ssadd))
    (ssadd (entlast) ss)
    (command "line" "0,0" "6,0" "")
    (ssadd (entlast) ss)
    (command "line" "0,0" (polar '(0 0) 0.2618 6) "")
    (ssadd (entlast) ss)
    (command "line" "0,0" (polar '(0 0) 1.309 6) "")
    (ssadd (entlast) ss)
    (command "-block" "MyArrow" '(0 0) ss "")
    (command "-color" "ByLayer")
  ) ;defun
 
;;;=============================================
;;;   ArcC    Arc Leader with Circle Arrow Head
;;;   Uses the current layer & Circle Arrow head
;;;=============================================

(defun ArcC (/ ArcEnt)
  (setq ArcEnt (list (entlast) ptpick))
  (Command "_.Circle" ptpick 2) ; circle arrow head 2" radius
  (command "_trim" (entlast) "" ArcEnt "")
) ;  end defun

;;;=============================================
;;;   ArcArw    Arc Leader with Arrow Type Head
;;;   Uses the current layer & Block Arrow head
;;;=============================================

(defun arcArw (ptpick / L_Angle cenpt    rad      StartAng  arcdata
       EndAng ArwOffset
      )
  (vl-load-com)
  (setq arwsize 6)
      (setq vobj (vlax-ename->vla-object (entlast)))
      (setq stpt (trans (vlax-curve-getstartpoint vobj) 0 1))
      (setq enpt (trans (vlax-curve-getendpoint vobj)0 1))
      (setq len  (vlax-curve-getdistatparam vobj (vlax-curve-getendparam vobj)))
      (if (< (distance stpt ptpick) (distance enpt ptpick))
        (setq dist arwsize)
        (setq dist (- len arwsize)
              enpt stpt)
      )
      (setq p1 (trans (vlax-curve-getpointatdist vobj dist) 0 1)) ; UCS to WCS ; end of arrow
      (setq ang (- (* 180.0 (/ (angle ptpick p1) pi)) 45))
      (setvar "osmode" 0)
      ;; ----------   Arrow Head    ---------------
      (if (not (tblsearch "block" "MyArrow"))
        (MakeMyBlk)
      )
      (command "_.insert" "MyArrow" ptpick "" "" ang)
); end defun

;;;=============================================================
;;;=============================================================
;;;          Routine Starts Here
;;;=============================================================
;;;=============================================================
  (princ "\n")
  (princ "\n            Arc Leader - Version 1.3")
  (princ "\n")

;;; -------  Some Housekeeping   ------------------
  (setq usercmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setq useros (getvar "osmode"))
  (setvar "osmode" 0)
  (setq userANGDIR (getvar "angdir"))
  (setvar "angdir" 0)
  (if (not ArType) ; Set Arrow Type FOR THE FIRST TIME IN THE ROUTINE
      (setq ArType "Arrow")
  ) ; endif


  ;;  loop until user enters point or "C" or "A"
  (setq loop T)
  (while loop
    (initget 1 "Circle Arrow")
    (setq
      ptpick (getpoint
       (strcat "\nPick leader start point or [Circle / Arrow]:<" ArType ">"))
    )
    (cond
      ((= (type ptpick) 'LIST) ; point picked
       (setq loop nil) ; exit loop
      )
      ((or (= ptpick "Circle") (= ptpick "Arrow"))
       (setq ArType ptpick)
      )
      (T (alert "Pick point or enter C or A"))
    )
  ) ; end while

  (command "arc" ptpick pause pause)
  (if (= "ARC" (cdr (assoc 0 (entget (entlast)))))
    (progn ; arc created
      (setq Lastpt (getvar "lastpoint"))
      (cond
((= ArType "Arrow")
(ArcArw ptpick)
)
((= ArType "Circle")
(ArcC)
)
      )
    )
  ) ; endif

;;;==========  Exit Sequence  ============
  (*error* "")
  (princ)
  (list ptpick Lastpt) ; return the start & end point of the arc
) ;  end defun
(prompt "\nArc Leader Loaded, Type  ArcL  to run")
(princ)

;;;==========  End of Routine  ============

;;;/////////////
;;;    EOF
;;;\\\\\\\\\\\\\