TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: T-Square on May 28, 2008, 01:23:26 PM
-
Hello All,
I have this piece of old code that I have added with some new code. New code is error trap and space checking. Problem is that this used to work fine and put that arrow head on the arc correctly. As you can see by the drawing, it does not work correctly anymore.
I have attached the lisp, the block used in the lisp and a sample drawing.
Can anyone clue me in? Thanks.
(defun c:ARR (/ ANG)
(INITERR)
(setvar "CMDECHO" 0)
(command ".undo" "end")
(command ".undo" "m")
(setvar "CECOLOR" "bylayer")
(setvar "CELTYPE" "bylayer")
(setvar "CELWEIGHT" -1)
(setvar "SNAPMODE" 0)
(setq TMVAR(getvar "TILEMODE"))
(if (= TMVAR 0)
(setq DIMSC 1.0)
(setq DIMSC(getvar "DIMSCALE"))
)
(setq ANG(* (/ (GETVAR "LASTANGLE") PI)180.0))
(setvar "OSMODE" 1)
(command ".-insert" "AVR" pause DIMSC DIMSC ANG)
;;;
(command ".undo" "end")
(RESET)
(princ)
)
-
Where are you getting/setting an angle?
(setq ANG(* (/ (GETVAR "LASTANGLE") PI)180.0))
If I start a brand-spankin' new drawing, run your code, my arrow ends up pointing to the right because my last angle is '0' beause I didn't do anything remotely related to angles.
-
That's basically what I was going to say. What's in INITERR and RESET?
-
If i draw a 3 point arc the arrow is put in its correct spot. The problem may be in the (INITERR) code. You also may want to look at getting all the variables you are setting and then resetting those variable back to the original state when the program is done. For example:
(setq old_osmode (getvar "OSMODE"))
(setvar "OSMODE" 1)
.......Coding........ Then
(setvar "OSMODE" old_osmode )
-
The initerr and reset are part of the error trap. Initialize the error trap and when done, reset any modified variables.
The routine is to place an arrow head at the end of an arc that I use for showing wiring. So, the lastangle would be that of the arc that I just drew. It's supposed to align the arrowhead with the arc.
-
The error trap I use.
;;;
;;; ERROR.lsp
;;;
;;; Global Error Trap Routine
;;; Code adapted from AfraLisp web site
;;; http://www.afralisp.com
;;;
;;;
(defun ERROR ()
(prompt "\nT-Square Drafting & Design, LLC Global Error Trap Loaded...")
(princ)
)
;;;
(defun INITERR ()
(setq ATTDIA (getvar "ATTDIA"))
(setq ATTREQ (getvar "ATTREQ"))
(setq CLA (getvar "CLAYER"))
(setq COL (getvar "CECOLOR"))
(setq CLT (getvar "CELTYPE"))
(setq CLW (getvar "CELWEIGHT"))
(setq CME (getvar "CMDECHO"))
(setq HPSEP (getvar "HPSEPARATE"))
(setq LUN (getvar "LUNITS"))
(setq LUP (getvar "LUPREC"))
(setq OSM (getvar "OSMODE"))
(setq OTHM (getvar "ORTHOMODE"))
(setq PLW (getvar "PLINEWID"))
(setq PEA (getvar "PEDITACCEPT"))
(setq SNM (getvar "SNAPMODE"))
(setq TSTYLE (getvar "TEXTSTYLE"))
(setq TEMPERR *ERROR*)
(setq *ERROR* TRAP)
(princ)
)
;;;
(defun TRAP (ERRMSG)
(command nil nil nil)
(if (not (member ERRMSG '("Console Break" "Function Cancelled"))
)
(princ (strcat "\nError: " ERRMSG))
)
(command ".undo" "b")
(setvar "ATTDIA" ATTDIA)
(setvar "ATTREQ" ATTREQ)
(setvar "CLAYER" CLA)
(setvar "CECOLOR" COL)
(setvar "CELTYPE" CLT)
(setvar "CELWEIGHT" CLW)
(setvar "CMDECHO" CME)
(setvar "HPSEPARATE" HPSEP)
(setvar "LUNITS" LUN)
(setvar "LUPREC" LUP)
(setvar "OSMODE" OSM)
(setvar "ORTHOMODE" OTHM)
(setvar "PLINEWID" PLW)
(setvar "PEDITACCEPT" PEA)
(setvar "SNAPMODE" SNM)
(setvar "TEXTSTYLE" TSTYLE)
(princ "\nAn Error Has Occured... Enviroment Variables Have Been Reset...")
(setq *ERROR* TEMPERR)
(princ)
)
;;;
(defun RESET ()
(setq *ERROR* TEMPERR)
(setvar "ATTDIA" ATTDIA)
(setvar "ATTREQ" ATTREQ)
(setvar "CLAYER" CLA)
(setvar "CECOLOR" COL)
(setvar "CELTYPE" CLT)
(setvar "CELWEIGHT" CLW)
(setvar "CMDECHO" CME)
(setvar "HPSEPARATE" HPSEP)
(setvar "LUNITS" LUN)
(setvar "LUPREC" LUP)
(setvar "OSMODE" OSM)
(setvar "ORTHOMODE" OTHM)
(setvar "PLINEWID" PLW)
(setvar "PEDITACCEPT" PEA)
(setvar "SNAPMODE" SNM)
(setvar "TEXTSTYLE" TSTYLE)
(princ)
)
(princ "\n")
(princ "\nT-Square Drafting & Design, LLC Global Error Trap Loaded...")
(princ "\n")
-
I got three things for you.
1) I don't want to assume you always put the arrow on the start point of the arc, so have you looked into dxf code values for angle at arc endpoints. I think code 50 and 51 are what you're looking for. They give you the angle of the start point and endpoint of the arc (I believe from the center). Also, vlax-curve-xxx functions can help acad determine which point to place the arrow at. The arc endpoint angles would be helpful to you.
2)Contained in INITERR
(command ".undo" "b")
_______________You then negate it 2 and 3 calls later. I don't think the "end" and "mark" commands are needed, but as they say YMMV.
(command ".undo" "end")
(command ".undo" "m")
3) Do you ever get tired of seeing all those setvars or having to remember what it was you called that variable? I do. I've posted these a few times, but here you are again.
(defun mapvars;|Creates paired lst of progvars|;()
(mapcar '(lambda (x)
(cons x (getvar x))
)
(list "attdia" "cecolor" "celtype"
"celweight" "cmdecho" "offsetdist"
"clayer" "dimsah" "dimzin"
"expert" "ltscale" "osmode"
"plinewid" "snapmode" "thickness"
"users1" "users2" "users3"
"errno"
)
)
)
(defun remapvars;|resets lst from mapvars|;(lst)
(mapcar '(lambda (x) (setvar (car x) (cdr x))) lst)
)Add whatever variables you want to the mapvars and it will store your current setup. Being that it creates a variable with a list of paired items, you can feasibly call the information just like getvar though that seems a little redundant. However, you call it like so:
(setq map (mapvars))
...code here...
...you could even call remapvars throughout your code if you want...
(remapvars '(("osmode" . 1) ("clayer" . 0)));etc. etc.
;restore variables
(remapvars map)
I don't know what anybody thinks about that, but I like it. Cleans the code up a little and allows me to see the meat of the program. I also got tired of creating a new variable for every variable name I wanted to have remembered for restoration later.
Another way to look at those functions is if for some reason you need to get the original value of one of those variables, but you've already changed it for something else, rendering (getvar...) useless, you could call (cdr (assoc "variableNameHere" map)) and retrieve it without having to remember what that variable name was that you called the original getvar.
-
I use the following to add "break" symbols to lines, plines, arcs, mep wires...
Just pass the block's path, name and 'Y' or 'N' to use the current LTSCALE to scale the block or not.
All you do is select the object to "attach" the block to.
;;;==============================================================================================
;;; Function: MY-BLOCK01
;;;
;;; Description: Inserts a block with a block name, block path and 'use ltscale' option
;;; passed to the program.
;;; (load" BVH-BLOCKS");(BVH-BLOCK_LINE strBlockPath strBlockName "");
;;;==============================================================================================
(defun MY-BLOCK01 (strBlockPath strBlockName strUseLTScale /
objEnt pt1 pt2 ent2 layName ang lts objType)
(while (setq objEnt (entsel "\n Select a point on a line/pline/arc... "))
(progn
(setq objType (cdr (assoc 0 (entget (car objEnt)))))
(princ objType)
(setq pt1 (osnap (cadr objEnt) "_nea"))
(setq pt2 (osnap (cadr objEnt) "_endp"))
(setq ent2 (entget (setq entList (car objEnt))))
(setq layName (DXF 8 ent2))
(if (= strUseLTScale "Y")
(setq lts (getvar "ltscale"))
(setq lts 1.0)
)
(setvar "clayer" layName)
(setq ang (angle pt1 pt2))
(command "-insert" (strcat strBlockPath strBlockName) pt2 lts "" (rtd ang))
)
)
(princ)
)
-
Old School way of doing it, but it works.
For error routine... see above. Error routine is old school and not the way most would do it, but works for what I need... I guess.
Would be nice to see the rubber band effect on the second pick point --> "s" pause pause <-- but I will take what I can get. :-)
Thanks for all the input. Have an awesome day.
(defun c:ARR (/)
(INITERR)
(setvar "CMDECHO" 1)
(command ".undo" "end")
(command ".undo" "m")
(setvar "CECOLOR" "bylayer")
(setvar "CELTYPE" "bylayer")
(setvar "CELWEIGHT" -1)
(setvar "SNAPMODE" 0)
;;;
(GETSPACE)
;;;
(graphscr)
;;;
(command ".pline" pause "width" "0.0" "0.0" "a" "s" pause pause "l" "w" (* DIMSC 0.06250) "0.0" "l" (* DIMSC 0.1250) "")
;;;
(command ".undo" "end")
(RESET)
(princ)
)
;;;
;;;
(defun GETSPACE (/)
(if (and (equal (getvar "TILEMODE") 0)
(equal (getvar "CVPORT") 1)
)
(setq CSPACE 1);paper space
(setq CSPACE 0);model space.
)
(if (= CSPACE 1)
(setq DIMSC 1.0)
(setq DIMSC(getvar "DIMSCALE"))
)
)
-
Give this a try:
(defun c:ARR (/)
(INITERR)
(setvar "CMDECHO" 1)
(command ".undo" "end")
(command ".undo" "m")
(setvar "CECOLOR" "bylayer")
(setvar "CELTYPE" "bylayer")
(setvar "CELWEIGHT" -1)
(setvar "SNAPMODE" 0)
;;;
(graphscr)
;;;
(command ".pline"
pause
"width"
"0.0"
"0.0"
"a"
"s"
(getpoint (getvar 'lastpoint) "\n Select midpoint: ")
pause
"l"
"w"
(* (GETSPACE) 0.06250)
"0.0"
"l"
(* (GETSPACE) 0.1250)
""
)
;;;
(command ".undo" "end")
(RESET)
(princ)
)
;;;
;;;
(defun GETSPACE (/)
(if (and (equal (getvar 'TILEMODE) 0)
(equal (getvar 'CVPORT) 1)
)
1.0
(getvar 'DIMSCALE)
)
)
-
Yup...that's it. It's the getpoint that creates the rubber band effect right?
-
Getpoint does show a rubberband when supplied with a point. Take a look at your getspace code as well and how I implemented a bit different than before to not have a global variable.
-
Cool.
I saw the getspace mod. Cool. Yet another way to skin the cat. :-)
Thanks.
Back to lines and circles.
Have an awesome day.
-
Cool.
...
Have an awesome day.
You too :)
-
Nice one Ron.
I went back and modified my old FatLeader routine and added your sub.
Also added a correction for when the leader is too short for the head size.
My routine picks the head point first.
;;; By Charles Alan Butler : Last Modified 06/04/2008
;;; FatL.lsp (Fat Leader)
;;; This routine will create a tapered three point pline arc leader with arrow head
;;; The arrow head length & width may be changed within the code
;;; Code corrects for too short a leader by reducing the arrow head
;;; Uses the current layer
;;;====== Main Lisp Routine =======
(defun c:FatL (/ usercmd useros pthead ptstart ptmid
ptend err ArLen Width GetSpace totallen
)
(vl-load-com)
(defun GETSPACE ()
(if (and (zerop (getvar "TILEMODE"))
(equal (getvar "CVPORT") 1)
)
1.0
(getvar "DIMSCALE")
)
)
(princ "\n")
(princ "\n Fat Leader - Version 3.0")
(princ "\n")
;; ------- Some Housekeeping ------------------
(setq usercmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq useros (getvar "osmode"))
(setvar "osmode" 0)
;;-------------------------------------
;;----- Set Arrow Head Size ------
;;-------------------------------------
;|
;; Length = 6" @ DimScale 48
;; Width = 1.5" @ DimScale 48
(setq ArLen (* 0.125 (getvar "DIMSCALE")) ; Head length
Width (* 0.03125 (getvar "DIMSCALE")) ; Head Width
)
|;
;|
(setq ArLen (* (getvar "dimasz") (getvar "dimscale")) ; Head length
Width (/ ArLen 3.0) ; Head Width
) |;
(setq ArLen (* (GETSPACE) 0.1250) ; Head length
Width (* (GETSPACE) 0.06250) ; Head Width
)
;;-------------------------------------
;;----- Get Leader Location ------
;;-------------------------------------
(setq ptstart (getpoint "\nPick arrow start, middle then end point: "))
(setq ptmid (getpoint ptstart "\nPick middle then end point: "))
(setq err (vl-catch-all-apply
'vl-cmdf (list ".arc" ptstart
ptmid
pause
)))
(setq ptend (getvar "lastpoint"))
(if (not (vl-catch-all-error-p err))
(progn
(setq ent (entlast))
(setq totalLen (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)))
;; correct for too short a leader, max head is 4:1
(if (< TotalLen (* 4 Arlen)) ; scale the arrowhead down
(setq ArLen (* TotalLen 0.2)
Width (* TotalLen 0.1))
)
(if (equal (vlax-curve-getparamatpoint ent ptstart)
(vlax-curve-getstartparam ent) 0.0001)
(setq pthead (vlax-curve-getpointatparam ent (vlax-curve-getparamatdist ent ArLen)))
(setq pthead (vlax-curve-getpointatparam ent
(vlax-curve-getparamatdist ent
(- (vlax-curve-getdistatparam ent
(vlax-curve-getendparam ent)) ArLen))))
)
(entdel ent) ; remove the ARC object
;; ---------- Draw the pline ---------------
(command "_.pline" "non" ptstart "w" "0" Width ; arrow head
"non" pthead "w" "0" Width "A" "S" "non" ptmid ptend "")
)
)
;;========== Exit Sequence ============
(setvar "osmode" useros)
(setvar "CMDECHO" usercmd)
(princ)
) ; end defun
(prompt "\nType FatL to run")
(princ)
;;;========== End of Routine ============
-
Nice one Ron.
I went back and modified my old FatLeader routine and added your sub.
Also added a correction for when the leader is too short for the head size.
My routine picks the head point first.
;;; By Charles Alan Butler : Last Modified 06/04/2008
;;; FatL.lsp (Fat Leader)
;;; This routine will create a tapered three point pline arc leader with arrow head
;;; The arrow head length & width may be changed within the code
;;; Code corrects for too short a leader by reducing the arrow head
;;; Uses the current layer
;;;====== Main Lisp Routine =======
(defun c:FatL (/ usercmd useros pthead ptstart ptmid
ptend err ArLen Width GetSpace totallen
)
(vl-load-com)
(defun GETSPACE ()
(if (and (zerop (getvar "TILEMODE"))
(equal (getvar "CVPORT") 1)
)
1.0
(getvar "DIMSCALE")
)
)
(princ "\n")
(princ "\n Fat Leader - Version 3.0")
(princ "\n")
;; ------- Some Housekeeping ------------------
(setq usercmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq useros (getvar "osmode"))
(setvar "osmode" 0)
;;-------------------------------------
;;----- Set Arrow Head Size ------
;;-------------------------------------
;|
;; Length = 6" @ DimScale 48
;; Width = 1.5" @ DimScale 48
(setq ArLen (* 0.125 (getvar "DIMSCALE")) ; Head length
Width (* 0.03125 (getvar "DIMSCALE")) ; Head Width
)
|;
;|
(setq ArLen (* (getvar "dimasz") (getvar "dimscale")) ; Head length
Width (/ ArLen 3.0) ; Head Width
) |;
(setq ArLen (* (GETSPACE) 0.1250) ; Head length
Width (* (GETSPACE) 0.06250) ; Head Width
)
;;-------------------------------------
;;----- Get Leader Location ------
;;-------------------------------------
(setq ptstart (getpoint "\nPick arrow start, middle then end point: "))
(setq ptmid (getpoint ptstart "\nPick middle then end point: "))
(setq err (vl-catch-all-apply
'vl-cmdf (list ".arc" ptstart
ptmid
pause
)))
(setq ptend (getvar "lastpoint"))
(if (not (vl-catch-all-error-p err))
(progn
(setq ent (entlast))
(setq totalLen (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)))
;; correct for too short a leader, max head is 4:1
(if (< TotalLen (* 4 Arlen)) ; scale the arrowhead down
(setq ArLen (* TotalLen 0.2)
Width (* TotalLen 0.1))
)
(if (equal (vlax-curve-getparamatpoint ent ptstart)
(vlax-curve-getstartparam ent) 0.0001)
(setq pthead (vlax-curve-getpointatparam ent (vlax-curve-getparamatdist ent ArLen)))
(setq pthead (vlax-curve-getpointatparam ent
(vlax-curve-getparamatdist ent
(- (vlax-curve-getdistatparam ent
(vlax-curve-getendparam ent)) ArLen))))
)
(entdel ent) ; remove the ARC object
;; ---------- Draw the pline ---------------
(command "_.pline" "non" ptstart "w" "0" Width ; arrow head
"non" pthead "w" "0" Width "A" "S" "non" ptmid ptend "")
)
)
;;========== Exit Sequence ============
(setvar "osmode" useros)
(setvar "CMDECHO" usercmd)
(princ)
) ; end defun
(prompt "\nType FatL to run")
(princ)
;;;========== End of Routine ============
That's a schmancy looking leader :)
-
Thanks you Sir.
Always looking for a differently look. 8-)
-
CAB,
Hope you don't mind but I modified your routine a bit to entmake the leader on a certain layer and use:
(list ".pline" ptstart "a" "s" ptmid pause "")
instead of
(list ".arc" ptstart ptmid pause)
Using the pline made it easy to extract the bulge and fixes the arrowhead from being skewed when using tighter angles as shown below :).
*the only real issue I've noticed is the arc gets bigger when the two endpoints are close together and the midpoint distance from them is far away....but that does not seem like a common occurrence.
Ron
-
Good job Ron. I'll look at the code in the am.
ZZZzzzzzzz......
-
Ron and Alan
Pretty neat routine. Me likey.
Gary