Author Topic: Aligning Points and Polar Mode/Ortho  (Read 2157 times)

0 Members and 1 Guest are viewing this topic.

cmwade77

  • Swamp Rat
  • Posts: 1278
Aligning Points and Polar Mode/Ortho
« on: February 28, 2014, 04:53:44 PM »
I am rewriting my program to draw leaders, for various reasons, part of the program automatically lines up the leaders when they get close. I have been able to do this with ortho and polarmode turned off, no problem. But once I turn one of these on, I cannot get it to line up properly. I previously drew plines and used intersectwith to figure this out, but doing so slows down the routine a bit and I want to eliminate the need to do so.

Here is the code that I have so far (please note that this code is very far from being completed, but I want to make this work properly before adding everything else in):
Code: [Select]
(vl-cmdf "._-insert" "Uleader.dwg")(command); Insert in leader styles

(defun c:Uleader ( / *thisdrawing* *modelspace* *paperspace* *path* *IsCivil* *Prompt* *note* *poc* pos Pt1 Pt1Tst Pt2 Pt3 NewPoints StopLoop input code data FxPointv mlobj ax SnapAng sc AutoAlign FxPt2 FxPt3 Ang1 Line1 Line2)
;Supporting Functions
(defun PolarRound (ang deg)
  (* (/ pi (/ 180 (r2d deg))) (fix (/ (+ (/ pi (/ 360 (r2d deg))) ang) (/ pi (/ 180 (r2d deg))))))
)
;;  by CAB 10/05/2007
  ;;  Expects pts to be a list of 2D or 3D points
  ;;  Returns new pline object
  (defun makePline (spc pts)
    ;;  flatten the point list to 2d
    (if (= (length (car pts)) 2) ; 2d point list
      (setq pts (apply 'append pts))
      (setq pts (apply 'append (mapcar '(lambda (x) (list (car x) (cadr x))) pts)))
    )
    (setq
      pts (vlax-make-variant
            (vlax-safearray-fill
              (vlax-make-safearray vlax-vbdouble (cons 0 (1- (length pts))))
              pts
            )
          )
    )
    (vla-addlightweightpolyline spc pts)
  )
(defun bitcodef (value bit)
;; Originally Written by Lee Ambrosius on: 6/6/04
;; Modified by Chris Wade 1/13/2010
(if (zerop(logand bit value))
nil
T
);;
) ;defun bitcode
; Convert value in degrees to radians

(defun D2R (numberOfDegrees)
 (* pi (/ numberOfDegrees 180.0))
) ;_ end of defun

(defun R2D (nbrOfRadians)
 (* 180.0 (/ nbrOfRadians pi))
)
;End of supporting functions
(if (not (tblsearch "LAYER" "LEADER")) ; Check to see if layer exsists
(progn
(if (= 1 (getvar "pstylemode")); Add code to determine if layer already exists
(progn
(command "._-layer" "n" "LEADER" "color" "WHITE" "" "lweight" "DEFAULT" "" "ltype" "CONTINUOUS" "" "")
)
(progn
(command "._-layer" "n" "LEADER" "color" "WHITE" "" "lweight" "DEFAULT" "" "ltype" "CONTINUOUS" "" "pstyle" "BLACK" "" "")
)
)
)
)
(setq *thisdrawing* (vla-get-activedocument (vlax-get-acad-object)) ; Sets the drawing based variables
      *modelspace*  (vla-get-ModelSpace *thisdrawing*)
  *paperspace*  (vla-get-PaperSpace *thisdrawing*)
  *path* (getvar "dwgprefix")
  AutoAlign "")
(If (> (strlen *path*) 5)
(progn
(setq pos (vl-string-position (ascii "\\") *Path* (+ (vl-string-position (ascii "\\") *path* 5) 1)))
(If (or (= (strcase (substr *path* (+ pos 8) 1)) "C") (= (getvar "USERS5") "CIVIL"))
(setq *IsCivil* T)
)
)
)
(setvar "annoautoscale" 4)
(if (= *Content* nil)
(setq *Content* "MTEXT")
)
;End of setting drawing based variables
(while (= pt1 nil)
(setq Pt1 (getpoint "\nSelect starting point of leader: "))
(if (= pt1 nil)
(princ "\r*** You must select a starting point for the leader ***")
)
)
(if (= *IsCivil* T)
(SETVAR "CMLEADERSTYLE" "CIVIL")
(progn
(setq Pt1Tst (osnap Pt1 "_NEA"))
(If (= Pt1Tst nil)
(SETVAR "CMLEADERSTYLE" "BEINOB-R1")
(SETVAR "CMLEADERSTYLE" "BEIOB-R1")
)
)
)
(setq pt2 (trans (cadr (grread t 4 4)) 1 0))
(if (> (car pt1) (car pt2))
(setq pt3 (polar pt2 (* pi (/ 180 180.0)) 0.25))
(setq pt3 pt2)
)
(setq newpoints (vlax-make-safearray vlax-vbDouble '(1 . 6)))
(vlax-safearray-put-element newpoints 1 (car pt1))
(vlax-safearray-put-element newpoints 2 (cadr pt1))
(vlax-safearray-put-element newpoints 3 (caddr pt1))
(while (= StopLoop nil)
(setq *Prompt* "\rSpecify second leader point ")
(if (= *note* T)
(setq *prompt* (strcat *prompt* "** Note **"))
(setq *prompt* (strcat *prompt* "Note"))
)
(if (= *typ* T)
(setq *prompt* (strcat *prompt* "/" "** Typ **"))
(setq *prompt* (strcat *prompt* "/" "Typ"))
)
(cond
((= *poc* nil)
(setq *prompt* (strcat *prompt* "/" "Poc(d)"))
)
((= *poc* "-POC")
(setq *prompt* (strcat *prompt* "/" "** Poc **"))
)
((= *poc* "-POD")
(setq *prompt* (strcat *prompt* "/" "** Pod **"))
)
)
(if (= *IsCivil* T)
(setq *prompt* (strcat *prompt* "/" "** Civil **"))
(setq *prompt* (strcat *prompt* "/" "Civil"))
)
(setq *prompt* (strcat *prompt* "/Arrowheads/cOntent: " AutoAlign))
(princ *prompt*)
(setq input (grread t 4 4)
  code (car input)
  data (cadr input)
)
(cond
((= code 3)
(setq StopLoop T)
)
((= code 5)
(if (/= data nil)
(progn
(setq FxPt (trans data 1 0))
(if (> (car pt1) (car FxPt))
(setq FxPt (polar FxPt (d2r 180) 0.18))
)
(cond
((= (getvar "orthomode") 1)
(setq SnapAng (d2r 90))
)
((= (bitcodef (getvar "autosnap") 8) T)
(setq SnapAng (getvar "polarang"))
)
(T
(setq SnapAng 0)
)
)
(if (> SnapAng 0)
(setq FxPt (polar pt1 (PolarRound (angle pt1 FxPt) SnapAng) (distance pt1 FxPt)))
)
(if (not (acet-sys-shift-down))
(progn
(setq AutoAlign "")
(if (/= UlLastPoint nil)
(progn
(if (or (/= (getvar "cvport") 1) (/= (getvar "tilemode") 0))
(setq sc (/ 1 (getvar "cannoscalevalue")))
(setq sc 1)
)
(if (< (distance FxPt (list (car UlLastPoint) (cadr FxPt))) (* 0.5 sc))
(progn
(setq AutoX T)
(if (> SnapAng 0)
(Progn
(setq FxPt (list (car UlLastPoint) (cadr FxPt)); When turned on, it doesn't work.
      Ang1 (PolarRound (angle Pt1 FxPt) SnapAng)
      FxPt (polar Pt1 Ang1 (distance pt1 (list (car UlLastPoint) (cadr FxPt))))
)
)
(setq FxPt (list (car UlLastPoint) (cadr FxPt))); This works fine when orthomode and snapang are turned off
)
)
(progn
(setq AutoX nil)
(if (< (distance FxPt (list (car FxPt) (cadr UlLastPoint))) (* 0.5 sc))
(setq AutoY T)
(setq AutoY nil)
)
)
)
)
)
)
(setq AutoAlign " (Autoalign Overide Activated)")
)
(vlax-safearray-put-element newpoints 4 (car FxPt))
(vlax-safearray-put-element newpoints 5 (cadr FxPt))
(vlax-safearray-put-element newpoints 6 (caddr FxPt))
(if (and (/= mlobj nil) (not (vlax-erased-p mlobj)))
(vla-delete mlobj)
)
(if (or (/= (getvar "cvport") 1) (/= (getvar "tilemode") 0))
(setq mlobj (vla-AddMleader *modelspace* newpoints 0))
(setq mlobj (vla-AddMleader *paperspace* newpoints 0))
)
(setq ax (vla-get-dogleglength mlobj))
(if (> (car pt1) (car FxPt))
(progn
(vla-put-dogleglength mlobj 0); This code is from http://www.theswamp.org/index.php?topic=31348.msg369336#msg369336
; Code from: http://www.theswamp.org/index.php?topic=30817.0
(vla-SetDogLegDirection mlobj 0 (vlax-3D-point (list (if (<= (car pt1) (car FxPT)) 1 -1) 0 0)))
; End of code from: http://www.theswamp.org/index.php?topic=30817.0
(vla-put-dogleglength mlobj ax); This code is from http://www.theswamp.org/index.php?topic=31348.msg369336#msg369336
)
)
(vla-put-Layer mlobj "leader")
)
)
)
)
)
(setq UlLastPoint FxPt)
)
As you can see, theswamp has been very helpful in getting this to work, even in it's original form, so I would like to thank everyone for that help.

Please note that you will need the uleader.dwg file in a location that AutoCAD can find it.

cmwade77

  • Swamp Rat
  • Posts: 1278
Re: Aligning Points and Polar Mode/Ortho
« Reply #1 on: February 28, 2014, 07:00:12 PM »
Ok, I think that I have found the right function to do this, but it's still not working for some reason.

Here is the old code (note: MakePline is a function to create polylines):
Code: [Select]
(setq anga (PolarRound (angle pt1 FxPt) SnAng)
            FxPt2 (polar pt1 anga (distance pt1 LastPoint))
  FxPt3 (polar LastPoint (d2r 90) 1)
)
(if (or (/= (getvar "cvport") 1) (/= (getvar "tilemode") 0))
(setq Line1 (makePline *modelspace* (list pt1 FxPt2))
Line2 (makePline *modelspace* (list LastPoint FxPt3)))
(setq Line1 (makePline *paperspace* (list pt1 FxPt2))
         Line2 (makePline *paperspace* (list LastPoint FxPt3)))
)
(setq FxPt (vlax-invoke Line1 'intersectWith Line2 acExtendBoth))
(if (and (/= Line1 nil) (not (vlax-erased-p Line1)))
(vla-delete Line1)
)
(if (and (/= Line2 nil) (not (vlax-erased-p Line2)))
(vla-delete Line2)
)


And here is the new code:
Code: [Select]
(setq Ang1 (PolarRound (angle Pt1 FxPt) SnapAng)
FxPt2 (polar pt1 ang1 (distance pt1 UlLastPoint))
FxPt3 (polar UlLastPoint (d2r 90) 1)
FxtPt (inters pt1 FxPt2 UlLastPoint FxPt3 nil)
)

Now, I am trying to figure out what the difference is, aside from not actually making the polylines. I believe the inters function should eliminate the need to do that, but for some reason, it's not working.

cmwade77

  • Swamp Rat
  • Posts: 1278
Re: Aligning Points and Polar Mode/Ortho
« Reply #2 on: March 03, 2014, 01:50:03 PM »
Ok, I did find why inters won't work, it still requires physical lines.....so anyone have any ideas?

CAB

  • Global Moderator
  • Seagull
  • Posts: 10395
Re: Aligning Points and Polar Mode/Ortho
« Reply #3 on: March 03, 2014, 02:18:50 PM »
Only points required.
Quote
(inters pt1 pt2 pt3 pt4 [onseg])
 All points are expressed in terms of the current UCS. If all four point arguments are 3D, inters checks for 3D intersection. If any of the points are 2D, inters projects the lines onto the current construction plane and checks only for 2D intersection.
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

cmwade77

  • Swamp Rat
  • Posts: 1278
Re: Aligning Points and Polar Mode/Ortho
« Reply #4 on: March 03, 2014, 02:53:21 PM »
Only points required.
Quote
(inters pt1 pt2 pt3 pt4 [onseg])
 All points are expressed in terms of the current UCS. If all four point arguments are 3D, inters checks for 3D intersection. If any of the points are 2D, inters projects the lines onto the current construction plane and checks only for 2D intersection.
Ok, then why wouldn't the code above work?

No matter what I do, it won't work, unless I draw the lines in, then it will work. Any thoughts as to why this would be?
« Last Edit: March 03, 2014, 06:12:28 PM by cmwade77 »

CAB

  • Global Moderator
  • Seagull
  • Posts: 10395
Re: Aligning Points and Polar Mode/Ortho
« Reply #5 on: March 04, 2014, 08:16:59 AM »
N o time today maybe Wednesday I can take a look.
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

cmwade77

  • Swamp Rat
  • Posts: 1278
Re: Aligning Points and Polar Mode/Ortho
« Reply #6 on: March 04, 2014, 01:18:31 PM »
It was a simple typo, I had Fxtpt instead of Fxpt for my variable.  :ugly:

Something so overly simplistic and obvious, yet I couldn't see it.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10395
Re: Aligning Points and Polar Mode/Ortho
« Reply #7 on: March 04, 2014, 01:44:39 PM »
A good way to check that is to run VLIDE & have it localize the variables.
Then you check for extra variables.
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.