How to select 2 points with ortho mode ON or OFF

[mengseng]

I have one balloon lisp program as below, can anyone help me to add some command so that I can select point p1 & p3 with ortho mode ON for align line or ortho mode OFF for free angle line. Now this program can only draw free angle line even ortho mode ON :

(setq num1 1)
(defun c:balloon ()

;;Circle Radius
(setq rad (* (getvar "dimscale") 2.0))

;;Text Height
(setq ts (* (getvar "dimscale") 2.0))

;;Get Use Input
(setq p1 (getpoint "\nStart point of Arrow: "))
(setq p3 (getpoint "\nBalloon point: "))
(setq num (getint (strcat "\nBalloon Number: <" (itoa num1) ">")))
(if (= num nil)
(setq num num1)
(setq num1 num)
)
(setq p2 (polar p3 (angle p3 p1) rad))

;;Line Entity
(setq l1 (list (cons 0 "LINE")
(cons 8 "balloon") ;Layer
(cons 10 p1) ;Start Point
(cons 11 p2) ;End Point
)
)

;;Circle Entity
(setq l2 (list (cons 0 "CIRCLE")
(cons 8 "balloon") ;Layer
(cons 10 p3) ;Center Point
(cons 40 rad) ;Radius
)
)

;;Text Entity
(setq l3 (list (cons 0 "TEXT")
(cons 8 "balloon") ;Layer
(cons 62 120) ;Text Colour
(cons 10 p3) ;Insert Point
(cons 11 p3) ;Insert Point
(cons 41 1) ;Text Width
(cons 40 ts) ;Text Height
(cons 1 (itoa num)) ;Text Content
(cons 7 "Romans") ;Text Style
(cons 72 1) ;Align Horizontal Center
(cons 73 2) ;Align Vertical Center
)
)

;;Make Entity
(entmake l1)
(entmake l2)
(entmake l3)

(setq num1 (1+ num1))

(princ)
)

[ Moderator Action = ON ] What are [ CODE ] tags... (http://forums.augi.com/misc.php?do=bbcode#code) [ Moderator Action = OFF ]

[Tom Beauford]

I have one balloon lisp program as below, can anyone help me to add some command so that I can select point p1 & p3 with ortho mode ON for align line or ortho mode OFF for free angle line. Now this program can only draw free angle line even ortho mode ON :
This will turn ortho on and off for you (setq othm (getvar "orthomode"))
(setq othm (getvar "orthomode"))
(setvar "orthomode" 1) ;Ortho on
(setvar "orthomode" 0) ;Ortho off
(setvar "orthomode" othm)
, but for ortho to work use the pt option to set p3. (setq p1 (getpoint "\nStart point of Arrow: "))
(setq p3 (getpoint p1 "\nBalloon point: "))

[rkmcswain]

Try this. See notes in red


(setq num1 1)
; added local variables
(defun c:balloon ( / L1 L2 L3 NUM P1 P2 P3 RAD TS OM ORTHOMODE RET)
; store current value of orthomode
(setq orthomode (getvar "orthomode"))

;;Circle Radius
(setq rad (* (getvar "dimscale") 2.0))

;;Text Height
(setq ts (* (getvar "dimscale") 2.0))

;;Get Use Input
;; get input regarding type of balloon
(initget "O F")
(setq ret (getkword "\n Balloon type [Freehand/<O>rtho] "))
(if (or (not ret) (eq ret "O"))
(setq om 1)
(setq om 0)
)

(setq p1 (getpoint "\nStart point of Arrow: "))
;; set ortho to correct mode
(setvar "orthomode" om)
(setq p3 (getpoint p1 "\nBalloon point: "))
;; reset orthomode to original setting
(setvar "orthomode" orthomode)

(setq num (getint (strcat "\nBalloon Number: <" (itoa num1) ">")))
(if (= num nil)
(setq num num1)
(setq num1 num)
)
(setq p2 (polar p3 (angle p3 p1) rad))

;;Line Entity
(setq l1 (list (cons 0 "LINE")
(cons 8 "balloon") ;Layer
(cons 10 p1) ;Start Point
(cons 11 p2) ;End Point
)
)

;;Circle Entity
(setq l2 (list (cons 0 "CIRCLE")
(cons 8 "balloon") ;Layer
(cons 10 p3) ;Center Point
(cons 40 rad) ;Radius
)
)

;;Text Entity
(setq l3 (list (cons 0 "TEXT")
(cons 8 "balloon") ;Layer
(cons 62 120) ;Text Colour
(cons 10 p3) ;Insert Point
(cons 11 p3) ;Insert Point
(cons 41 1) ;Text Width
(cons 40 ts) ;Text Height
(cons 1 (itoa num)) ;Text Content
;; test to see if "romans" exists before trying to use it.
(if (tblsearch "style" "romans")
(cons 7 "romans")
(cons 7 (getvar "textstyle"))
)
(cons 72 1) ;Align Horizontal Center
(cons 73 2) ;Align Vertical Center
)
)

;;Make Entity
(entmake l1)
(entmake l2)
(entmake l3)

(setq num1 (1+ num1))

(princ)
)




You could also add code to do "ghosting" so you could see location of bubble before picking it. If you are interested, let me know.

[intergrupocr]

You could also add code to do "ghosting" so you could see location of bubble before picking it. If you are interested, let me know.
Sorry, I'm interested about "ghosting", Thanks in advance!!!!:beer:

[rkmcswain]

Here is a quickie sample of a ghosting technique.

Note that it only ghosts the circle as a hexagon and I didn't bother to trim the line at the circle during the ghosting. These items could be adjusted to your liking.

Also, note that this breaks the ORTHO mode of this routine. To add that back you would have to calculate the quadrant of the cursor relative to the first picked point during the ghosting and then calculate an ortho location based on that. In other words if the cursor is at 10 degrees, calculate and draw the circle at 0 degrees, if the cursor is rotated CCW towards 90 degrees, the circle would stay at 0 until the cursor crosses the 45 deg mark, then the circle moves to 90 degrees, and so on....



(setq num1 1)

(defun c:balloon ( / L1 L2 L3 NUM P1 P2 P3 RAD TS OM ORTHOMODE RET DRAG GHOSTPT TIME)
;;; added function
(defun gcir (pt rad / PT1 PT2 PT3 PT4 PT5 PT6 PT7 PT8)
(setq pt1 (polar pt 0 rad)
pt2 (polar pt (* pi 0.25) rad)
pt3 (polar pt (* pi 0.5) rad)
pt4 (polar pt (* pi 0.75) rad)
pt5 (polar pt (* pi 1.0) rad)
pt6 (polar pt (* pi 1.25) rad)
pt7 (polar pt (* pi 1.5) rad)
pt8 (polar pt (* pi 1.75) rad))
(grvecs (list 2 pt1 pt2 2 pt2 pt3 2 pt3 pt4 2 pt4 pt5 2 pt5 pt6 2 pt6 pt7 2 pt7 pt8 2 pt8 pt1))
)

; store current value of orthomode
(setq orthomode (getvar "orthomode"))

;;Circle Radius
(setq rad (* (getvar "dimscale") 2.0))

;;Text Height
(setq ts (* (getvar "dimscale") 2.0))

;;Get Use Input
;; get input regarding type of balloon
(initget "O F")
(setq ret (getkword "\n Balloon type [Freehand/<O>rtho] "))
(if (or (not ret) (eq ret "O"))
(setq om 1)
(setq om 0)
)

(setq p1 (getpoint "\nStart point of Arrow: "))
;; set ortho to correct mode
(setvar "orthomode" om)

;;; loop while dragging cursor
(setq time T)
(while time
(setq drag (grread t 1 1))
(cond ((= (car drag) 5) ;<- while cursor is moving
(setq ghostpt (cadr drag))
(redraw)
(grdraw ghostpt p1 2)
(gcir ghostpt rad)
)
((= (car drag) 3) ;<- picked point
(setq p3 (cadr drag))
(setq time nil)
)
)
)


;; reset orthomode to original setting
(setvar "orthomode" orthomode)

(setq num (getint (strcat "\nBalloon Number: <" (itoa num1) ">")))
(if (= num nil)
(setq num num1)
(setq num1 num)
)
(setq p2 (polar p3 (angle p3 p1) rad))

;;Line Entity
(setq l1 (list (cons 0 "LINE")
(cons 8 "balloon") ;Layer
(cons 10 p1) ;Start Point
(cons 11 p2) ;End Point
)
)

;;Circle Entity
(setq l2 (list (cons 0 "CIRCLE")
(cons 8 "balloon") ;Layer
(cons 10 p3) ;Center Point
(cons 40 rad) ;Radius
)
)

;;Text Entity
(setq l3 (list (cons 0 "TEXT")
(cons 8 "balloon") ;Layer
(cons 62 120) ;Text Colour
(cons 10 p3) ;Insert Point
(cons 11 p3) ;Insert Point
(cons 41 1) ;Text Width
(cons 40 ts) ;Text Height
(cons 1 (itoa num)) ;Text Content
(if (tblsearch "style" "romans")
(cons 7 "romans")
(cons 7 (getvar "textstyle"))
)
(cons 72 1) ;Align Horizontal Center
(cons 73 2) ;Align Vertical Center
)
)

;;Make Entity
(entmake l1)
(entmake l2)
(entmake l3)
;;; redraw for cleanup
(redraw)
(setq num1 (1+ num1))

(princ)
)

[intergrupocr]

Thanks!! I will play for a while!!!

[mengseng]

Thanks Tom and Rkmcswain

I will try the code both of you supply.

Thanks a lot :)

I had change the code as below, it's work. I use F8 button to switch orthomode between ON/OFF before select point p3

(setq p3 (getpoint p1 "\nBalloon point: "))

[mengseng]

ghosting technique is new to me, need some time for study :)
Thank for your sample code.

I had try run the code you supply, seem like nothing different when i select Freehand/Ortho

[rkmcswain]

ghosting technique is new to me, need some time for study :)
Thank for your sample code.

I had try run the code you supply, seem like nothing different when i select Freehand/Ortho

As I said in that message - "Also, note that this breaks the ORTHO mode of this routine."

It wasn't meant to be a finished routine, only an example.

[mengseng]

As I said in that message - "Also, note that this breaks the ORTHO mode of this routine."

It wasn't meant to be a finished routine, only an example.

sorry didn't read carefully. ok, i will go through your example & try to create new code with ortho/free angle mode, if i stuck in somewhere, i will come back to you :)