Topic: [XDrX-Function(1)] Entity projected onto the plane of the current UCS

[xdcad]

https://www.theswamp.org/index.php?topic=58129.0

Code - Auto/Visual Lisp: [Select]

1. ;|
2. Get the Z axis of UCS
3. Parameters: none
4. Return value: vector
5. |;
6. (defun XD::UCS:zDir()
7.    (xdrx_vector_crossProduct (getvar "ucsxdir") (getvar "ucsydir"))
8. )
9.  

Code - Auto/Visual Lisp: [Select]

1. ;|
2. Function name: XD::Project->UCSPLANE
3. effect：The solid is projected onto the current UCS plane
4.  
5. param:
6.    ss -- Selection or Entity List
7.  
8. return: selection or entity list
9. |;
10. (defun XD::Project->UCSPLANE (ss / ents plane g g1 e1)
11.   (if (= (type ss) 'PICKSET)
12.     (setq ss (xdrx-pickset->ents ss))
13.   )
14.   (setq plane (xdge::constructor
15.                 "kPlane"
16.                 (getvar "ucsorg")
17.                 (XD::UCS:zDir)
18.               )
19.   )
20.   ;Coordinate UCS PLANE AcGe kPlane
21.   (mapcar '(lambda (x)
22.              (setq g (xdge::constructor x))
23.   ; Generate AcGe curve from AcDb curve
24.              (setq g1 (xdge::getpropertyvalue g "orthoproject" plane))
25.   ;Geometric curves are orthogonally projected onto the plane plane
26.              (setq e1 (xdge::entity:make g1))
27.   ;Generate entity after projection
28.              (xdrx-entity-matchprop x e1)
29.   ;The entity attributes match the original curve, color, layer, linetype....
30.              (xdrx-object-swapid e1 x)
31.   ;Entity ObjectId exchange to ensure that the newly generated curve entity name remains unchanged
32.              (xdrx-entity-delete e1)
33.   ;Delete the original curve
34.              (xdrx-object-release g)
35.   ;Geometric curve entities release memory
36.            )
37.           ss
38.   ;Select set to entity table
39.   )
40.   (xdge::free plane)
41.   ;Geometry plane object releases memory
42.   (if (= (type ss) 'PICKSET)
43.     (xdrx_entity->pickset ss)
44.     ss
45.   )
46. )
47.  

Code - Auto/Visual Lisp: [Select]

1. ;|
2. Function name: XD::Project->PLANE
3. effect：The entity is projected onto the plane specified by the Z-axis vector
4. param:
5.    ss    -- Selection or Entity List
6.    normal-- Projecttion Plane Z axis da unit vector
7.  
8. return: selection or entity list
9. |;
10. (defun XD::Project->PLANE (ss normal / ents plane g g1 e1)
11.   (if (= (type ss) 'PICKSET)
12.     (setq ss (xdrx-pickset->ents ss))
13.   )
14.   (setq plane (xdge::constructor
15.                 "kPlane"
16.                 '(0 0 0)
17.                 normal
18.               )
19.   )
20.   ;Coordinate PLANE AcGe kPlane
21.   (mapcar '(lambda (x)
22.              (setq g (xdge::constructor x))
23.   ; Generate AcGe curve from AcDb curve
24.              (setq g1 (xdge::getpropertyvalue g "orthoproject" plane))
25.   ;Geometric curves are orthogonally projected onto the plane plane
26.              (setq e1 (xdge::entity:make g1))
27.   ;Generate entity after projection
28.              (xdrx-entity-matchprop x e1)
29.   ;The entity attributes match the original curve, color, layer, linetype....
30.              (xdrx-object-swapid e1 x)
31.   ;Entity ObjectId exchange to ensure that the newly generated curve entity name remains unchanged
32.              (xdrx-entity-delete e1)
33.   ;Delete the original curve
34.              (xdrx-object-release g)
35.   ;Geometric curve entities release memory
36.            )
37.           ss
38.   ;Select set to entity table
39.   )
40.   (xdge::free plane)
41.   ;Geometry plane object releases memory
42.   (if (= (type ss) 'PICKSET)
43.     (xdrx_entity->pickset ss)
44.     ss
45.   )
46. )

Code - Auto/Visual Lisp: [Select]

1. (defun c:tt ()
2.    (if (setq ss (xdrx-ssget "\nSelect entities to be projected onto the current UCS plane <exit>:"))
3.      (progn
4.        (setq ss (xd::project->ucsplane ss))
5.        (xdrx-entity-redraw ss 1)
6.      )
7.    )
8.    (princ)
9. )