Hey everyone,
Was hoping someone could shed some light on my situation here.
Still learning so I hope someone can explain what going on with this code.
For the most part this code works but I am having a couple issues with it and I cant find out why.
First I am trying to set the osnap to be 545 then return it back to the original settings.
When I use (setq os (getvar 'osmode)) it doesnt seem to reset back to original settings if you break mid way through.
I think that has to do with the VLA-OBJECT nil error but I can't seem to find where it is. I think its part of the _NextTrick subfunction, but I dont have a ton of experience debugging things like this.
Does anyone have any thoughts on what can be causing the error on the break?
(defun C:itp ( / lay1 lay2 lay3 blk blk1 blk2 blk3 acadobj adoc msp activeundo txt dis newhgt ang1 grdtxt tmpln inserted pt1 pt2 pt3 pm par atb cl counter hgt1 hgt2 os str ent1 ent2 os *error*)
(vl-load-com)
;Set Undo start mark
(vla-endundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
(vla-startundomark adoc)
;Error Function
(defun *error* ( msg / adoc tmpln)
(if tmpln (entdel tmpln))
(if os (setvar "osmode" os))
(if cl (setvar 'clayer cl))
(if blk (entdel blk))
(vla-EndUndoMark adoc)
(if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*"))
(princ (strcat "Error: " msg))
)
);end *error
;;START COMMAND;;
(setq os (getvar "osmode")
cl (getvar 'clayer)
)
;Set Layers and block names
(setq lay1 "S-Slope-Frozen"
lay2 "PROP-GRADE"
lay3 "SLOPE-PH1"
blk1 "DRAR"
blk2 "Grade_Point"
blk3 "PSEX"
);End setq for varible layers and blocks
(setvar 'clayer lay2)
;create the layers if they do not exist
(if (null (tblsearch "LAYER" lay1))
(entmake
(list
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(70 . 0)
(cons 2 lay1)
(cons 62 222)
(cons 290 0)
)
)
);end if
(setvar "osmode" 545)
(_getelevs)
;(while (and (/= ent1 nil)(/= ent2 nil)) ;NEED TO ADD SOMETHING HERE TO CHECK BEFORE IT CONTINUES THE WHILE LOOP
(SETQ pt3 (GETPOINT "\nSelect Interpolation point(s) along the line: [ENTER to Exit]")
pt3 (list(car pt3)(cadr pt3) 0 )
)
;;****************DO THE MATH*****************;;
(setq pm (/ (distance pt1 pt3)(distance pt1 pt2))
dis (- hgt2 hgt1)
newhgt (+ hgt1 (* pm dis))
ang1 (+ (angle pt1 pt2)(angle '(0 0 0) (trans '(1 0 0) 1 0 t)))
grdtxt (rtos newhgt 2 2)
)
(if (and (> ang1 (DtR 180))(< ang1 (DtR 360)))
(setq ang1 (+ (angle pt2 pt1)(angle '(0 0 0) (trans '(1 0 0) 1 0 t))))
)
(cond
((setq blk (vlax-invoke
(vlax-get
(vla-get-ActiveLayout
(vla-get-activedocument
(vlax-get-acad-object)))
'Block)
'InsertBlock (trans pt3 1 0)
blk2 1 1 1 ang1)
);_ setq
(setq atb (Car (vlax-invoke blk 'Getattributes)))
(vla-put-textstring atb grdtxt)
(princ "\n<< Pick point for text location >>")
(_NextTrick blk)
(setq inserted (cons blk inserted)
);_setq
);_ cond 1
((and (setq str (eq (type pt3) 'STR))(eq pt3 "U") inserted)
(vla-delete (car inserted))
(setq inserted (Cdr inserted)
counter (1- counter))
);_cond 2
(str (princ "\nNothing to UNDO")
)
);_ end cond
;Add the calculations to the command line so newbies can understand how interpolation works.
(prompt "\nInterpolate point equation: ")
(prompt "\nInterpolated Value = ( Distance From X to Interp Point / Total Distance ) X ( Grade Value X - Grade Value Y ) + Grade Value X")
(prompt (strcat "\n" grdtxt " = ((" (rtos (distance pt1 pt3) 2 4) " / " (rtos (distance pt1 pt2) 2 4) ") x (" (rtos hgt2 2 2)" - " (rtos hgt1 2 2) ")) + " (rtos hgt1 2 2)")"))
(princ)
;)
(if tmpln (entdel tmpln))
(setvar "osmode" os)
(setvar 'clayer cl)
(redraw ent1 4)
(redraw ent2 4)
;Undo Mark
(vla-endundomark adoc)
(princ)
)
(defun _NextTrick (blk / end code pt2 hypotenuse p)
(while
(and (null end)
(setq p (grread t 15 0)
code (car p)))
(cond
((= 5 code)
(setq hypotenuse (distance (vlax-get blk 'insertionpoint) (trans (cadr p) 1 0)))
(vla-put-value (nth 2 (vlax-invoke blk 'getdynamicblockproperties))
(* -1 hypotenuse (cos (- (angle (trans (cadr p) 1 0) (vlax-get blk 'insertionpoint))
(vlax-get blk 'rotation)
)
)
)
)
(vla-put-value (nth 3 (vlax-invoke blk 'getdynamicblockproperties))
(* -1 hypotenuse (sin (- (angle (trans (cadr p) 1 0) (vlax-get blk 'insertionpoint))
(vlax-get blk 'rotation)
)
)
)
)
)
((or (= 2 code) (= code 3))
(setq end T)))
)
)
