Getpoint function fails
Richard Preator
worked. For some reason we now have some drawing templates that the program
fails on. These are new drawing templates with our titleblock boarder, and
set up for 3D use in MD 6. When we run the program we get this message;
Command: ball
Enter Start Point of Leader at Object:
Enter Center of Balloon:
Value must be positive and nonzero.
; error: Function cancelled
Specify radius of circle or [Diameter]:
Once the Function Cancels then as shown on the last line above it asks for
the radius of the circle.
There seems to be some switch that is set wrong in our template, because
this program works o.k. in other older drawings.
Any Suggestions appreciated!!
Richard Preator
Central Manufacturing
Kevin Nehls
on what is different between these "problem" templates and the "good"
templates.
--
Kevin Nehls
"Richard Preator" <rpre...@centraleng.net> wrote in message
news:D52EDDEFFCD0F8B3...@in.WebX.maYIadrTaRb...
Richard Preator
; *********************************************************************
; * Draws balloon with text in center for naming items. *
; * *
; *********************************************************************
(defun c:rpball()
; **** initialization ****
(setvar "cmdecho" 0)
(setq old (getvar "orthomode"))
(setvar "orthomode" 0)
(setq oldsnap (getvar "osmode"))
(setq sty (getvar "snapstyl"))
(setvar "snapstyl" 0)
(setq ang (getvar "snapang"))
(setq scl (getvar "dimtxt"))
(setq scl1 (getvar "dimscale"))
(setq Dscl (* scl scl1))
(setq Cscl (* Dscl 1.2))
(setq storela (getvar "curlayer"))
(setq k#clayer (getvar "clayer"))
(if (/= storela "DIM") (command "layer" "m" "DIM" ""))
(command "osmode" 512)
(setq ldr_start (getpoint "\n Enter Start Point of Leader at Object: "))
(prompt "\n Enter Center of Balloon: ")
(command "osnap" "none")
(command "line" ldr_start pause "")
(setq ldr_end (getvar "lastpoint")) ; Note: program fails at this point.
(command "erase" "l" "")
(setq A (angle ldr_start ldr_end))
(setq Aang (* 180 (/ A pi)))
(setq Ascl (* 0.32 Dscl))
(setq point (polar ldr_start A Dscl))
(command "pline" ldr_start ldr_end "")
(command "pedit" "l" "edit" "insert" point "P" "w" "0.0" Ascl "x" "x")
(command "circle" ldr_end Cscl)
(setq circl (entlast))
command "change" circl "" "p" "c" 1 "");was (command "change" circl "" "p"
"")
(command "trim" circl "" ldr_end "")
(setq txt (getstring "\nItem Number: "))
(command "text" "j" "m" ldr_end Dscl "0" (princ txt))
(command "change" "l" "" "p" "c" 1 ""); was (command "change" "l" "" "p"
"")
; (command "redraw")
;**** reset variables ****
(setvar "cmdecho" 1)
(setvar "snapstyl" sty)
(setvar "snapang" ang)
(setvar "orthomode" old)
(setvar "clayer" k#clayer)
(setvar "osmode" oldsnap)
(PRIN1)
)
Richard Preator
"Kevin Nehls" <kevinn at safeworks dot com> wrote in message
news:9F3CE39E2F94452A...@in.WebX.maYIadrTaRb...
Jason Piercey
variables. IOW, put them after a / in the (defun) statement just to
eliminate any possibility of variable conflicts.
(defun c:rpball ( / old oldsnap sty ang scl scl1 etc.....)
--
-Jason
Member of the Autodesk Discussion Forum Moderator Program
LE
There you go sir...
(defun c:rpball (/ old oldsnap sty ang scl
scl1 Dscl Cscl storela k#clayer
ldr_start ldr_end a aang Ascl
point circl txt)
(setvar "cmdecho" 0)
(setq old (getvar "orthomode"))
(setvar "orthomode" 0)
(setq oldsnap (getvar "osmode"))
(setq sty (getvar "snapstyl"))
(setvar "snapstyl" 0)
(setq ang (getvar "snapang"))
(setq scl (getvar "dimtxt"))
(setq scl1 (getvar "dimscale"))
(setq Dscl (* scl scl1))
(setq Cscl (* Dscl 1.2))
(setq storela (getvar "curlayer"))
(setq k#clayer (getvar "clayer"))
(if (/= storela "DIM")
(command "._layer" "_m" "DIM" ""))
(command "._osmode" 512)
(setq ldr_start
(getpoint "\n Enter Start Point of Leader at Object: "))
(prompt "\n Enter Center of Balloon: ")
(command "._osnap" "_none")
(command "._line" ldr_start pause "")
(setq ldr_end (getvar "lastpoint"))
(command "._erase" "_l" "")
(setq A (angle ldr_start ldr_end))
(setq Aang (* 180 (/ A pi)))
(setq Ascl (* 0.32 Dscl))
(setq point (polar ldr_start A Dscl))
(command "._pline" ldr_start ldr_end "")
(command "._pedit" "_l" "_edit" "_insert" point "_P" "_w" "0.0" Ascl
"_x" "_x")
(command "._circle" ldr_end Cscl)
(setq circl (entlast))
(command "._change" circl "" "_p" "_c" 1 "")
(command "._trim" circl "" ldr_end "")
(setq txt (getstring "\nItem Number: "))
(command "._text" "_j" "_m" ldr_end Dscl "0" (princ txt))
(command "._change" "_l" "" "_p" "_c" 1 "")
(setvar "cmdecho" 1)
(setvar "snapstyl" sty)
(setvar "snapang" ang)
(setvar "orthomode" old)
(setvar "clayer" k#clayer)
(setvar "osmode" oldsnap)
(princ))
(princ)
John Uhden
Here's your program with a few fixes and a little error control. I avoided the
"Line" command by using a second (getpoint). You can get that "rubberband"
effect by using (getpoint <reference point> <prompt>).
(defun c:rpball ( / *error* sty ang old clayer oldsnap ang scl scl1
Dscl Cscl A Ang Ascl point ldr_start ldr_end circl txt)
(defun *error* (msg)
;**** reset variables ****
(setvar "clayer" clayer)
(setvar "cmdecho" 1)
(setvar "snapstyl" sty)
(setvar "snapang" ang)
(setvar "orthomode" old)
(setvar "clayer" clayer)
(setvar "osmode" oldsnap)
(cond
((not msg))
((wcmatch (strcase msg) "*QUIT*,*CANCEL*"))
(T (princ (strcat "\nERROR: " msg)))
)
(princ)
)
; **** initialization ****
(setq old (getvar "orthomode"))
(setq clayer (getvar "clayer"))
(setq oldsnap (getvar "osmode"))
(setq sty (getvar "snapstyl"))
(setvar "cmdecho" 0)
(setvar "orthomode" 0)
(setvar "snapstyl" 0)
(setq ang (getvar "snapang"))
(setq scl (getvar "dimtxt"))
(setq scl1 (getvar "dimscale"))
(setq Dscl (* scl scl1))
(setq Cscl (* Dscl 1.2))
(if (/= clayer "DIM") (command "_.layer" "_m" "DIM" ""))
(command "_.layer" "_T" "DIM" "_Unlock" "DIM" "")
(setvar "osmode" 512)
(and
(setq ldr_start (getpoint "\nEnter Start Point of Leader at Object: "))
(setvar "osmode" 0)
(setq ldr_end (getpoint ldr_start "\n Enter Center of Balloon: "))
(progn
(setq A (angle ldr_start ldr_end))
(setq Aang (* 180 (/ A pi)))
(setq Ascl (* 0.32 Dscl))
(setq point (polar ldr_start A Dscl))
(command "_.pline" ldr_start ldr_end "")
(command "_.pedit" "l" "_edit" "_insert" point "_P" "_w" "0.0" Ascl "_x"
"_x")
(command "_.circle" ldr_end Cscl)
(setq circl (entlast))
(command "_.change" circl "" "_p" "_c" 1 "");was (command "change" circl
"" "p" "")
(command "_.trim" circl "" ldr_end "")
(initget 1)
(setq txt (getstring "\nItem Number: "))
(command "_.text" "_j" "_m" ldr_end Dscl "0" (princ txt))
(command "_.change" "_la" "" "_p" "_c" 1 ""); was (command "change" "l" ""
"p" "")
(redraw)
)
)
(*error* nil)
)
--
John Uhden, Cadlantic/formerly CADvantage
http://www.cadlantic.com
Sea Girt, NJ
"Richard Preator" <rpre...@centraleng.net> wrote in message
news:3E7F7163F894AC86...@in.WebX.maYIadrTaRb...
Herman Mayfarth =>=>tktn.com>
;;; Acknowledgement: To John F. "Quick Draw" Uhden, for showing
;;; the way.
;;function to entmake leaders
(defun tktn_ldr (pthtyp arwlayer ldrtyp / p1 p2 |p1 |p2 dimsty nvert
ptlist rtlist elist)
(setq dimsty (getvar "DIMSTYLE"))
(if(tblsearch "DIMSTYLE" (strcat (getvar "DIMSTYLE") "$7"))
(setq dimsty (strcat dimsty "$7"));defaults to parent style
); ;if no leader child exists
(setq elist (list(cons 0 "LEADER")
(cons 100 "AcDbEntity") ;required!
(cons 8 arwlayer) ;layer
(cons 100 "AcDbLeader") ;what it is
(cons 3 dimsty) ;dimension style
(cons 71 1) ;arrow flag
(cons 72 pthtyp) ;path type
)
);setq
(setq |p1 (getpoint "\nEnd of Leader:"))
(setq p1 (trans |p1 1 0))
(setq ptlist (list (cons 10 p1)))
(while (setq |p2 (getpoint |p1 "\n Next Point:"))
(progn
(setq p2 (trans |p2 1 0))
(grdraw |p1 |p2 -1)
(setq ptlist (cons (cons 10 p2) ptlist))
(setq |p1 |p2)
);progn
);while
(if (< 1 (length ptlist))
(progn
(setq nvert (length ptlist)
rtlist (list (cdadr ptlist)
(cdar ptlist))
)
(if (null ldrtyp) (setq ptlist (reverse ptlist)))
(entmake (append elist (list(cons 76 nvert)) ptlist (list(cons 77
256))))
(command "_.REDRAW")
);progn
(princ "\nNot enough points!\n")
);if
rtlist;return list of last two points selected
);end tktn_ldr
;;also, JU has also posted code here to associate a bubble block with the
LEADER, (provided you like the way AutoCAD does this).
:)
Notes:
1. I don't really like the way the above function works, because it is a
"service" function which requests user input (yecch). If I were to (re)write it
today, I think I would (maybe) try to separate out the user input of points,
and pass the (entmake)ing function a point list. But, it works.
2. The attached file works well in R14, but I just tried it in 2002 and it
fails to pause for user input of the block attribute values, even though I have
the usual:
(while (= (logand (getvar "CMDACTIVE")1)1)
(command pause))
following the (command "_.-INSERT")
I dunno(?)
Later,
hm
Richard Preator
and unfortunately it did not correct the problem. I have posted the drawing
template file to customer files. I suspect there is some switch is autocad
that is causing the problem. If someone has the time I would appreciate it
if they would try making a baloon in the .dwt file.
Thanks again!!
Richard Preator
Central Manufacturing
"LE" <www.arqcom.com.mx> wrote in message
news:63B4BA887674EA43...@in.WebX.maYIadrTaRb...
Jason Piercey
--
-Jason
Member of the Autodesk Discussion Forum Moderator Program
> I've seen the IOW now a few times. Still can't figure out what it stands
for, I would guess it is "I something would"???
Kevin Nehls
You can check for a zero value with (zerop <num>). This way you can ensure
that you don't pass a zero value when you don't want to.
--
Kevin Nehls
"Michel" <mtrot...@netscape.net> wrote in message
news:3D356E27...@netscape.net...
> Your dimscale is set to 0....so your diameter is 0 !!!
>
> Michel
>
John Uhden
or Lehden. Hey... as long as they don't call me "$#!+h&@d."
--
John Uhden, Cadlantic/formerly CADvantage
http://www.cadlantic.com
Sea Girt, NJ
"DDR" <d...@bgark.com> wrote in message news:f0f7...@WebX.maYIadrTaRb...
> John, I've been curious also about how you pronounce your last name.
> TIA
>
> Rob Davis
>
Michel
Michel
Richard Preator a écrit :
John Uhden
In R15+, it's better to turn ATTREQ off, do the insert, then
(if (assoc 66 (entget (entlast)))(command ".DDATTE" (entlast)))
If you don't mind using rectangular bubbles, then tolerances and leaders can be
associative, otherwise the bubble block would have to have its insertion point
at the center of the circle, contain wipeout within the circle to hide the end
of the leader, and the attribute on top (Block insertions can be associated with
leaders).
--
John Uhden, Cadlantic/formerly CADvantage
http://www.cadlantic.com
Sea Girt, NJ
"Herman Mayfarth =>=>tktn.com>" <h_mayfarth@=> wrote in message
news:VA.0000019...@hostname.not.set.up...
--------------------------------------------------------------------------------
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Bubble.LSP ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Created: Nov 1999
;;; Current file: 27 Feb. 00
;;; Version: 1.4
;;; Author: Herman Mayfarth (c) 1999,2000
;;; h_may...@tktn.com
;;; http://www.tktn.com
;;; Purpose: Creates callout bubbles with leaders
;;;
;;; Provided as is. Permission granted to freely use & redistribute
;;; without fee provided this notice remains intact.
;;; Notice also applies to external functions.
;;;
;;; Written for and tested with AutoCAD Release 14.01
;;; Also tested casually with AutoCAD 2000.
;;;
;;; Known bugs & limitations:
;;;
;;; 1. tktn_ldr unconditionally adds xdata to scale the leader
;;; arrow size. This results in added xdata when none is really
;;; needed, in certain cases. Should make no difference to the user.
;;;
;;; Acknowledgements: to Peter Farrell for his helpful suggestions.
;;; to David Doane for the R2K -insert tip
;;;
;;; Modification history:
;;; 27 Feb 00 Added code to shut down OSNAPs before calling INSERT
;;; due to the extra "and" prompt when int OSNAP is on
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Function C:BUBBLE
;;; Purpose: draws leader with callout bubble
;;; Needs: user input of points
;;; External functions: tktn_ldr,tktn_getscl
;;; Block definition: mk_bubl0 (that's a zero)
;;; with a circle of radius 0.17, somewhere on your search path
;;; Returns: nil
;;; Autoscales the block insert, based on sf set by tktn_getscl
;;; Autoscales the leader arrow size, based on sf
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;Now all you need is a bubble block.
;;;You can use my radius value of 0.170 and block name "mk_bubl0"
;;;or change those to suit your own purposes.
;;;
;;;here are the external functions:
;;;
;;;---------------------tktn_ldr-------------------------------
;;; function to entmake leaders, forward or backward
;;; Uses: pthtyp: 0 = straight, 1 = splined
;;; arwlayer: string specifies layer
;;; ldrtyp: nil = forward, non-nil = backward
;;; Returns: rtlist: list containing last 2 points selected
;;;-------------------------------------------------------------
(defun tktn_ldr (pthtyp arwlayer ldrtyp / p1 p2 |p1 |p2 dimsty nvert
ptlist rtlist elist)
(setq dimsty (getvar "DIMSTYLE"))
(if (tblsearch "DIMSTYLE" (strcat (getvar "DIMSTYLE") "$7"))
(setq dimsty (strcat dimsty "$7"));defaults to parent style
); ;if no leader child exists
(setq elist (list'(0 . "LEADER")
'(100 . "AcDbEntity") ;required!
'(100 . "AcDbLeader") ;what it is
(cons 3 dimsty) ;dimension style
(cons 8 arwlayer) ;layer
(cons 71 1) ;arrow flag
(cons 72 pthtyp) ;path type
)
);setq
(setq |p1 (getpoint "\nEnd of Leader:")
p1 (trans |p1 1 0)
ptlist (list (cons 10 p1))
)
(while (setq |p2 (getpoint |p1 "\n Next Point:"))
(progn
(setq p2 (trans |p2 1 0))
(grdraw |p1 |p2 -1)
(setq ptlist (cons (cons 10 p2) ptlist)
|p1 |p2)
);progn
);while
(if (< 1 (length ptlist))
(progn
(setq nvert (length ptlist)
rtlist (list (cdadr ptlist)
(cdar ptlist))
)
(if (null ldrtyp) (setq ptlist (reverse ptlist)));T draws ldr backward
(setq elist (append elist (list(cons 76 nvert)) ptlist
(list(cons 77 256))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; *unconditionally* adds xdata to scale the leader arrow size,
;; based on the value returned by tktn_getscl,
;; based on a suggestion by Peter Farrell 11/7/99
(setq elist (append elist (list (list
'-3
(list
"ACAD"
'(1000 . "DSTYLE")
'(1002 . "{")
'(1070 . 40)
(cons 1040 (tktn_getscl))
'(1002 . "}")
)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(entmake elist)
(redraw)
);progn
(princ "\nNot enough points!\n")
);if
rtlist;last two points selected
);end tktn_ldr
;;--------------------- tktn_getscl--------------------------------------
;; Purpose: calculate scale factor
;; Uses: nothing
;; Returns: sf
;; which is equal to:
;; dimscale <-TILEMODE=1
;; 1 <-in paper space
;; viewport scale <-in a viewport
;; local symbols
;; curvpt: current viewport (integer - not saved by drawing)
;;-----------------------------------------------------------------
(defun tktn_getscl()
(cond ((= 1 (getvar "TILEMODE")) (getvar "DIMSCALE"));tiled space
((= 1 (getvar "CVPORT")) 1.0);in paper space
;; in a viewport - method due to Ian Bryant
(T
(last (trans '(0 0 1.0) 3 2));calc scale factor
)
);cond
);end tktn_getscl
;;;
(defun C:BUBBLE ( /
;;local functions
*lerror*
extbbl
;;local symbols
bblrad
olderr
pathtype
larwlayer
ldrtyp
rtlist
lastpt
sf
inspt
)
;;local error handler
(defun *lerror*(msg)
(extbbl)
(command "_.UNDO" "")
(setvar "OSMODE" (logand (getvar "OSMODE") 16383))
(redraw)
(if
(or
(= msg "Function cancelled")
(= msg "quit / exit abort")
)
(princ)
(princ (strcat "\nError: " msg))
);end if
(princ)
);end *lerror*
;; exit function
(defun extbbl ()
(command "_.UNDO" "END")
(setvar "CMDECHO" 1)
(setq *error* olderr)
(princ)
); end extbbl
(command "_.UNDO" "BEGIN")
(setvar "CMDECHO" 1)
(setq olderr *error*
*error* *lerror*)
(setq bblrad 0.170);this may change if using an alternate block
(setq larwlayer (getvar "CLAYER"));use current layer
(initget "Spline STraight")
(setq pathtype (getkword "\nLeader Pathtype: Spline <STraight>"))
(cond ((equal pathtype "Spline" )(setq pathtype 1))
(T (setq pathtype 0))
);cond
(setq rtlist (tktn_ldr pathtype larwlayer nil)
sf (tktn_getscl)
lastpt (cadr rtlist)
inspt (polar lastpt (angle (car rtlist) lastpt) (* bblrad sf))
inspt (trans inspt 0 1)
)
(setvar "TEXTEVAL" 1)
(setvar "OSMODE" (logior (getvar "OSMODE") 16384))
(if (> (distof (getvar "acadver") 2) 14.1)
(command "_.-INSERT" "MK_BUBL0" inspt sf sf 0.0);R15
(command "_.INSERT" "MK_BUBL0" inspt sf sf 0.0);R14
)
(while (=(logand(getvar "CMDACTIVE")1)1)
(command pause))
(setvar "OSMODE" (logand (getvar "OSMODE") 16383))
(setvar "TEXTEVAL" 0)
(extbbl)
(princ)
);end C:BUBBLE
;; Prompt at load time
(prompt " \nBubble V1.4 Copyright(c) 2000 by Herman Mayfarth.")
(prompt " \nType BUBBLE to run.")
(princ)