Topic: Any Testers out there ?

[Kerry]

This is the functions library :
< redundant file removed [ UCS_Testing.fas ]>

NOTE :
FILE UPDATED
HEADER UPDATED

This is the header

Code - Auto/Visual Lisp: [Select]

1. ;|
2. Header for UCS_Testing ..
3. kwb 2005.JUL.03
4.  
5. [i]Header included in Later post[/i]
6.  
7. |;

This is a test routine :

Code - Auto/Visual Lisp: [Select]

1. (or (= 'SUBR (type kb:VEC:GetPathVector)) (load "UCS_Testing.fas"))
2.  
3. (defun c:test ()
4.   (if
5.     (and (setq TemplateEnt (entsel "\nSelect Template Entity :"))
6.          (setq RefPointInUCS (getpoint "\nSelect Reference Point : "))
7.          (setq NewPointInUCS (getpoint "\nSelect Insertion Point : "))
8.          (setq
9.            vlaTemplateEnt (vla-Copy
10.                             (vlax-ename->vla-object (car TemplateEnt))
11.                           )
12.          )
13.     )
14.      (kb:CopyFromPlanarToWCS->PlanarToUCS vlaTemplateEnt
15.                                           RefPointInUCS
16.                                           NewPointInUCS
17.      )
18.   )
19.   (princ)
20. )

Functionality:
Copy the selected object as represented in the WCS plane to the current UCS plane.
Origin can be any point planar to the WCS.
Target can be any point planar to the UCS.

[daron]

Sorry Kerry. I wish I could test it for you. I don't have ACAD here at home. Hope someone pops in soon who does.

[Kerry]

Thanks for the thought Daron.

I'ts not bomb proof yet, but I would be interested in seeing where it breaks.

... I have an idea how inventive some folks can be ..

[Kerry]

This is some examples from the Library ..

Sorry, I dont have a CHM for it yet ..

Code: [Select]

;|
(kb:VEC:CalculateLength '(4 3 0))
=> 5.0

(kb:VEC:Normalize '(4 3 0))
=> (0.8 0.6 0.0)

(kb:VEC:CalculateLength (kb:VEC:Normalize '(4 3 0)))
=> 1.0

(kb:VEC:Convert->Radians '(4 3 0))
=> 0.643501

(kbsf:rtd (kb:VEC:Convert->Radians '(4 3 0)))
=> 36.8699
|;

[Jeff_M]

Jeez, a Saturday night of a (USA) 3-day weekend, my wife is working graveyard shift, I'm watching a rain-delayed NASCAR race and otherwise quite bored, and here comes Kerry to wake me up!

But, of course, I don't use UCS's (also meaning that I don't know HOW to use them properly) so I can't even set up a test platform to test his test.

*shrug* /me wishes Kerry good luck and goes back to the race.....

[daron]

Interesting. Looks like some kind of logarithmic thing I don't yet have a firm grasp on, but I like how you can wrap one function inside another for differing results.

[Kerry]

Jeff :- you a fuelHead ?

Long story short:

I'm using a closed entity < circle, pline, region > as a template to extrude along a path object located anywhere in 3D space < any linear object >

There were 2 glitches
 
UCS's must be named to extract ActiveX info.
Regions have their 'Normal property ReadOnly, so we have to go through hoops with translations.

I think this library solves those issues. .. but I'm just about brain dead, and it's almost time for the football.

ps .. Have a fun holiday weekend if you get one ..

[Kerry]

Jeff, this is the sort stuff I play with when I'm not hacking code :

[Jeff_M]

Whoa! That's pretty cool Kerry. Are those for the BIGGG earthmovers?

BTW, thanks for the quick explanation. And, yeah, I put racing pretty high on my priority list. I used to work on Sprint cars, many moons ago, but now I'm just an Easy chair "backseat" driver. The only track close to me is a road course (Infineon, formerly known as Sears Point) and for years I attended most races held there. But the amount of fans has increased to the point it's more enjoyable at home or the local pub with a handful of fellow fans.

I will have a good remainder of my weekend, thanks. Enjoy your football (is that football or soccer?)

[Kerry]

Rugby league .. today [ I used to play .. which explains the bumps on my head ]
Rugby Union and Australian Rules Football Yesterday. < I read during the boring bits>
Not really a big soccer fan .. but sometimes get caught up in a game.

not earthmoving ..
Those are a type of underpan used in the mining industry .. catch the wet junk during processing.
These are about 3.700 M X  1.800 M and a shade under 2 tonne each. < sorry for the metric >

[Amsterdammed]

Kerry,

You want with this code copy a solid from on side of the construction and use it on another side?

Bernd

[Kerry]

Kerry,

You want with this code copy a solid from on side of the construction and use it on another side?

Bernd

I'm using a closed entity < circle, pline, region >

... should work with solids as well.

basically from anywhere to anywhere, BUT .. the "view" in the WCS is copied into the "View" of the UCS. < if you know what I mean > .

[Kerry]

** WOOt **
Translate and extrude 

Code - Auto/Visual Lisp: [Select]

1. (defun c:test2 ()
2.   ;; kwb 2005.JUL.03
3.   ;;
4.   ;; Variables local for testing
5.   (setq TemplateEnt (kbsf:entsel "Select Template Entity"
6.                                  nil
7.                                  nil
8.                                  ;;'("Region" "LwPolyline""Circle" "Polyline" "Ellipse")
9.                                  ;; NOTE check that LWPLine is closed.
10.                                  ;; restrict selection initially.
11.                                  ;;
12.                                  (list "Region")
13.                                  nil
14.                                  nil
15.                     )
16.   )
17.   (setq vlaTemplate
18.          (vla-Copy (vlax-ename->vla-object (car TemplateEnt)))
19.   )
20.   (setq RefPointInUCS (getpoint "\nSelect Reference Point : "))
21.   (setq RefPointInWCS (trans RefPointInUCS acucs acworld))
22.   (setq PathEnt (kbsf:entsel "Select Path Entity"
23.                              nil
24.                              nil
25.                              ;;'("Line" "LwPolyline" "Polyline" "Circle" "Arc" "Ellipse" "Spline")
26.                              ;; restrict selection initially.
27.                              ;; added : path type options increased kwb
28.                              ;; (list "LwPolyline" )
29.                              (list "LwPolyline"  "Polyline"
30.                                    "Circle"      "Arc"
31.                                    "Ellipse"     "Line"
32.                                   )
33.                              nil
34.                              nil
35.                 )
36.   )
37.   (setq vlaPathObj (vlax-ename->vla-object (car PathEnt)))
38.   (setq PathVector (kb:VEC:GetPathVector vlaPathObj))
39.   (setq vlaOriginalUCS (kb:UCS:NameCurrent "saved"))
40.   ;; assume path is LWPLine for now ...
41.   ;; so the translated Template YAxis will be the Path Normal
42.   ;; grab the variant safearray Normal
43.   ;;
44.   (setq PathNormal (vlax-get vlaPathObj 'Normal))
45.   (setq PathStartPointInWCS (vlax-curve-getStartPoint vlaPathObj))
46.   (setq vlaNewUCS (kb:UCS:BlackBox
47.                     "Path"                        ; Name
48.                     PathStartPointInWCS           ; Origin      :<PointList (X Y Z)>
49.                     (kb:VEC:CrossProduct PathNormal PathVector)
50.                                                   ; XAxis               :<VectorList (X Y Z)>
51.                     PathNormal                    ; YAxis               :<VectorList (X Y Z)>
52.                     T                             ; Activate
53.                   )
54.   )
55.   ;;
56.   ;; mojo with the template ..
57.   (kb:CopyFromPlanarToWCS->PlanarToUCS
58.     vlaTemplate
59.     (trans RefPointInWCS acworld acucs)
60.     '(0.0 0.0 0.0)
61.   )
62.   ;; The template is already a region, so no need to convert it.
63.   ;; ... will need to when we do the other stuff later ...
64.   ;;
65.   ;; assume model space for this test .. check later
66.   ;;
67.   (setq vlaSolid (vla-AddExtrudedSolidAlongPath g:modelspace
68.                                                 vlaTemplate
69.                                                 vlaPathObj
70.                  )
71.   )
72.   (vla-put-color vlaSolid acYellow)
73.   (vla-put-activeUCS g:activedoc vlaOriginalUCS)
74.   (vla-delete vlaTemplate)
75.   (princ)
76. )
77.  

Before ..

.... and after ...
The Cyan rectangle is the template, The red Pline is the Path target.

[Kerry]

Ooops . ya'all need this ..

added at update : a variation of this has been added to the UCS-VEC-LIBrary.fas Library file.

Code - Auto/Visual Lisp: [Select]

1. ;;;------------------------------------------------------------------
2. ;;;------------------------------------------------------------------
3. ;;;
4. ;;; kwb 20021103
5. ;;; kbsf:entsel (msg kwd def typelist selectflag lockflag
6.  
7. ;;; Arguments:
8. ;;; msg : The prompt string.
9. ;;; kwd : Initget keywords string.
10. ;;; def : Value to return if response is <enter>.
11. ;;; typelist  : Stringlist of entity types allowed for selection. If nil select anything.
12. ;;; selectflag : If true nentsel permitted , otherwise use entsel.
13. ;;; lockflag  : If true dont allow selection from locked layers.
14. ;;;
15. ;;; Note : Arguments may be set to nil
16. ;;;
17. ;;; Return output from (n)entsel, a key word, the default argument, or nil.
18. ;;;
19. ;; example1 : (kbsf:EntSel "Select Arc Object" nil nil (list "ARC" "CIRCLE") nil T)
20. ;;  ==>  (<Entity name: 40bcd540> (-28175.1 154575.0 1250.0))
21. ;; example2 : (kbsf:EntSel "Select Datum Line" nil nil (list "LINE") T T) ; line in block
22. ;;  ==>  (<Entity name: 4022c680> (-21613.1 142392.0 0.0)
23. ;;  ((70.0 0.0 0.0) (0.0 70.0 0.0) (0.0 0.0 70.0) (-21611.9 142635.0 0.0))
24. ;;          (<Entity name: 4022c6b8>)  )
25.  
26. (defun kbsf:entsel
27.        (msg kwd def typelist selectflag lockflag / pickok returnvalue tmp)
28.   (setq msg (strcat "\n"
29.                     (cond (msg)
30.                           ("Select object")
31.                     )
32.                     " : "
33.             )
34.   )
35.   (while (not pickok)
36.     (setvar "ERRNO" 0)
37.     (if kwd
38.       (initget kwd)
39.     )
40.     (setq returnvalue (if selectflag
41.                         (nentsel msg)
42.                         (entsel msg)
43.                       )
44.     )
45.     (cond
46.       ((= (getvar "ERRNO") 52)      ; enter
47.        (if def
48.          (setq returnvalue def)
49.        )
50.        ;; skip out
51.        (setq pickok t)
52.       )
53.       ((= (getvar "ERRNO") 7)
54.        (princ "Nothing found at selectedpoint. ")
55.       )
56.       ((= (type returnvalue) 'str) (setq pickok t))         ; keyword
57.       ((and (setq tmp (entget (car returnvalue)))           ; object type
58.             typelist
59.             (not (member (cdr (assoc 0 tmp)) (mapcar 'strcase typelist)))
60.        )                                                    ; wrong type
61.        (alert
62.          (strcat
63.            "Selected object is not"
64.            "\na "
65.            (apply
66.              'strcat
67.              (cons (car typelist)
68.                    (mapcar '(lambda (x) (strcat "\nor " x)) (cdr typelist))
69.              )
70.            )
71.            ". "
72.          )
73.        )
74.       )
75.       ((and lockflag                                        ;Locked Layer Not Permitted
76.             (setq                                           ;layer name
77.               tmp (entget (tblobjname "LAYER" (cdr (assoc 8 tmp))))
78.             )
79.             (= (logand 4 (cdr (assoc 70 tmp))) 4)           ;is layer locked
80.        )
81.        (princ "Selected object is on a locked layer. ")
82.       )
83.       ;; skip out
84.       ((setq pickok t))
85.     )
86.   )
87.   returnvalue
88. )

[Kerry]

The holiday on that side of the pond has given me a chance to progress with this before too many people rip it apart.

The original <now redundant> fas has been removed from the lilly-pond.

New Library File :
http://www.theswamp.org/lilly_pond/kerrybrown/UCS-VEC-LIBrary.fas?nossi=1

New Test Code :
The rotation option may be interesting for some.

"Confirm Rotation about Axis [X +180/ Y +180/ Z+ 90/ Z- 270/ Continue]"
Options : rotate the template around the target UCS axes before extrusion.  Just use X, Y, Z or Z- ...   < see the piccy >
I use :- UCSICON  3  On and displayed at origin.

Template and Path TYPE's updated as indicated in the source.

I would be grateful if someone lets me know if they breaks this. 

Code - Auto/Visual Lisp: [Select]

1.  
2. (or (= 'SUBR (type kb:VEC:GetPathVector))
3.     (load "UCS-VEC-LIBrary.fas")
4. )
5.  
6. ;;;-------------------------------------------------------------
7. ;;;-------------------------------------------------------------
8. ;;
9.  
10. (defun c:test6 (/                *error*          CurentSpace
11.                 PathEnt          PathNormal       PathStartPointInWCS
12.                 PathVector       RefPointInUCS    RefPointInWCS
13.                 TemplateEnt      vlaNewUCS        vlaOriginalUCS
14.                 vlaPathObj       vlaRegion        vlaSolid
15.                 vlaTemplate
16.                )
17.   ;; kwb 2005.JUL.04
18.   ;;
19.   ;; add error trapping
20.   ;;
21.   ;;------standard error trap------------------
22.   (defun *error* (msg /) (kb:on-error msg))
23.   (vla-endundomark g:activedoc)                   ; end any open undo group
24.   (vla-startundomark g:activedoc)                 ; start new group  
25.   ;;-------------------------------------------
26.   (kb:savesysvar '(("CMDECHO" 0)
27.                    ("expert" 5)
28.                    ("UCSICON" 3)
29.                    ("BLIPMODE" 0)
30.                    ("SNAPANG" 0)
31.                    ("SNAPMODE" 0)
32.                    ("OSMODE" 0)
33.                    ("SNAPANG" 0)
34.                    ("PICKADD" 1)
35.                    ("PICKBOX" 5)
36.                    ("SORTENTS" 1)
37.                    
38.                   )
39.   )
40.   ;;-------------------------------------------
41.   (setq TemplateEnt    (kb:entsel "Select Template Entity { to extrude } "
42.                                   nil
43.                                   nil
44.                                   (list "Region"       "Circle"
45.                                         "Ellipse"      "LwPolyline"
46.                                         "Polyline"
47.                                        )
48.                                   nil
49.                                   nil
50.                        )
51.         RefPointInUCS  (getpoint "\nSelect Reference Point on Template : ")
52.         RefPointInWCS  (trans RefPointInUCS acucs acworld)
53.         PathEnt        (kb:entsel "Select Path Entity"
54.                                   nil
55.                                   nil
56.                                   (list "LwPolyline"  "Polyline"
57.                                         "Circle"      "Arc"
58.                                         "Ellipse"     "Line"
59.                                        )
60.                                   nil
61.                                   nil
62.                        )
63.         vlaPathObj     (vlax-ename->vla-object (car PathEnt))
64.         PathVector     (kb:VEC:GetPathVector vlaPathObj)
65.         vlaOriginalUCS (kb:UCS:NameCurrent "saved")
66.   )
67.   ;; the translated Template YAxis will be oriented to the Path Normal initially
68.   ;; grab the variant safearray Normal
69.   ;;
70.   (setq PathNormal          (vlax-get vlaPathObj 'Normal)
71.         PathStartPointInWCS (vlax-curve-getStartPoint vlaPathObj)
72.         vlaNewUCS           (kb:UCS:BlackBox
73.                               "Path"              ; Name
74.                               PathStartPointInWCS ; Origin      :<PointList (X Y Z)>
75.                               (kb:VEC:CrossProduct PathNormal PathVector)
76.                                                   ; XAxis               :<VectorList (X Y Z)>
77.                               PathNormal          ; YAxis               :<VectorList (X Y Z)>
78.                               T                   ; Activate
79.                             )
80.         ;;
81.         ;; mojo with the template ..
82.         ;;
83.         vlaTemplate         (vla-Copy (vlax-ename->vla-object (car TemplateEnt)))
84.         CurentSpace         (if
85.                               (or
86.                                 (= acmodelspace (vla-get-activespace g:activedoc))
87.                                 (= :vlax-true (vla-get-mspace g:activedoc))
88.                               )
89.                                g:modelspace
90.                                (vla-get-paperspace g:activedoc)
91.                             )
92.   )
93.   (kb:CopyFromPlanarToWCS->PlanarToUCS
94.     vlaTemplate
95.     (trans RefPointInWCS acworld acucs)
96.     '(0.0 0.0 0.0)
97.   )
98.   ;;
99.   ;; convert the template to a region
100.   ;;
101.   (cond
102.     ((= "AcDbRegion" (vla-get-objectname vlaTemplate))
103.      ;; It's a region already, no need to convert
104.      (setq vlaRegion vlaTemplate)
105.     )
106.     ((vl-position (vla-get-objectname vlaTemplate)
107.                   '("AcDbCircle" "AcDbEllipse")
108.      )
109.      (setq vlaRegion (kb:convertToRegion vlaTemplate CurentSpace))
110.     )
111.     ((vl-position (vla-get-objectname vlaTemplate)
112.                   '("AcDbPolyline" "AcDb3dPolyline")
113.      )
114.      (if (= :vlax-true (vla-get-closed vlaTemplate))
115.        (setq vlaRegion (kb:convertToRegion vlaTemplate CurentSpace))
116.        ;; else
117.        (prompt "\nUnable to Create Region to Extruded.")
118.      )
119.     )
120.     (T (prompt "\nUnable to Create Region to Extruded."))
121.   )
122.   ;;
123.   ;; Confirm the Rotation
124.   ;;
125.   ;;
126.   (if vlaRegion
127.     (progn (if (not (vlax-erased-p vlaTemplate))
128.              (vla-delete vlaTemplate)
129.            )
130.            (kb:ConfirmRotate vlaRegion)
131.            (setq vlaSolid (vla-AddExtrudedSolidAlongPath CurentSpace
132.                                                          vlaRegion
133.                                                          vlaPathObj
134.                           )
135.            )
136.            (vla-put-color vlaSolid acYellow)
137.     )
138.   )
139.   ;;
140.   ;;
141.   (vla-put-activeUCS g:activedoc vlaOriginalUCS)
142.   (if (not (vlax-erased-p vlaRegion))
143.     (vla-delete vlaRegion)
144.   )
145.   (*error* nil)
146.   (princ)
147. )
148.  
149. ;;;-------------------------------------------------------------
150. ;;;-------------------------------------------------------------
151. ;;
152.  
153. ;|«Visual LISP© Format Options»
154. (70 2 50 2 nil "end of " 70 40 0 0 0 nil nil nil T)
155. ;*** DO NOT add text below the comment! ***|;

Revised Header file for UCS-VEC-LIBrary.fas

Code - Auto/Visual Lisp: [Select]

1. ;|
2. Header for UCS_Testing ..
3. kwb 2005.JUL.03 : initial compilation.
4. kwb 2005.JUL.04 : revised and supplemented.
5. Exported Functions Defined as SUBRS :
6.  
7. /////
8.  
9. kb:UCS:BlackBox                                         (NewUcsName Origin XAxis YAxis Activate
10. kb:UCS:CheckAxisZero                    (vlaCurrentUCS
11. kb:UCS:GetCurrentNormal
12. kb:UCS:NameCurrent                              (UCSName < string or nil for default >
13. kb:UCS:NameWorld                                        (MakeActive < T or nil >
14. kb:UCS:TransFromWCStoUCS        (entname < ename or vlaObject >
15. kb:UCS:TransPointToOCS          (3dPt
16.  
17. kb:VEC:CalculateLength          (Vector
18. kb:VEC:Convert->Radians         (Vector
19. kb:VEC:CrossProduct                     (Vector1 Vector2
20. kb:VEC:GetPathVector                    (vlaObj
21. kb:VEC:Normalize                                        (Vector
22. kb:VEC:points->vector           (3dPt1 3dPt2
23. kb:VEC:ZeroAxisFuzz                     (VectorList
24. kb:VEC:vla3dPoint->List         (vla3dPoint
25.  
26. kb:ConfirmRotate                                        (vlaRegion
27. kb:convertToRegion                              (vlaObject CurentSpace
28. kb:CopyFromPlanarToWCS->PlanarToUCS (VLATemplateObject RefPointInUCS NewPointInUCS
29. kb:entsel                                                               (msg kwd def typelist selectflag lockflag    
30. kb:getpoint                                                     (msg
31. kb:getword                                                              (msg def bit kwd  
32. kb:lisp-value                                           (val
33. kb:on-error                                                     (msg
34. kb:ptos                                                                         (pt
35. kb:savesysvar                                           (vars_list
36. /////
37. Global Variables Defined as VLA-OBJECT :
38.  
39. g:acadapp                       : IAcadApplication Object
40. g:activedoc     : IAcadDocument Object
41. g:modelspace    : IAcadModelSpace Object
42. g:utility       : IAcadUtility Object
43. g:documents     : IAcadDocuments Collection
44. g:blocks                                : IAcadBlocks Collection
45. g:ucss                                  : IAcadUCSs Collection
46. g:layers                                : IAcadLayers Collection
47.  
48. |;

Snapshot at rotation prior to extrusion :-