Macro to Flatten all Points to a Plane

  • These 3  macros move all points to the specific plane.

    Contributed by: Lar
'*******MACRO-1 START**********
'Flatten-Z.d3m
'28 Jan 06 modified by Lar, Nassau, Bahamas
'added options and 'select only?' to Impulse's 'flat-z' macro..

'iterates through the drawing and sets all Z coordinates to 0

sys(1027)=1 ' message box style = OK/Cancel
message "This command will make Z value of points = 0 and can not be Undone. To proceed click OK. To Abort click Cancel..."
if sys(1028)=2 then end 'message box: 1=OK; 2=Cancel; 3=Abort; 4=Retry; 5=Ignore; 6=Yes; 7=No

if sys(80)>0 then 'if at least 1 entity is selected...
sys(1027)=3 'message box style = Yes/No/Cancel
message " Selected only?..."
if sys(1028)=2 then end 'message box: 1=OK; 2=Cancel; 3=Abort; 4=Retry; 5=Ignore; 6=Yes; 7=No
end if

'this requires that the dcadalias.d3i file be in the dcad root directory

Include "*\dcadalias.d3i"

For j = 1 To Sys(9) ' Sys(9) is the number of entities
Entity j

if sys(1028)=6 then 'if message box=yes (if selected only)
if sys(96)=0 then goto nex 'if entity is not selected [0=not selected, 1=selected]
end if

for i = 1 to sys(1)

Query Ent_Point, i, ptX, ptY, ptZ
Change Ent_Point, i, ptX, ptY, 0
update
next i

sys(1) = 0

nex:
next j

>regenerate
{
}

sys(1027)=0 ' message box style = OK (default)
message "Done. If no change is apparent then Fit to Window and /or Regenerate the drawing (or Regenerate All) ..."
'*******MACRO-1 END************


'*******MACRO-2 START**********
'Flatten-X.d3m
'28 Jan 06 modified by Lawrence C. Smith, Nassau, Bahamas
' make for x and added 'select only?' to Impulse's 'flat-z' macro..

'iterates through the drawing and sets all X coordinates to 0

sys(1027)=1 ' message box style = OK/Cancel
message "This command will make X value of points = 0 and can not be Undone. To proceed click OK. To Abort click

Cancel..."
if sys(1028)=2 then end 'message box: 1=OK; 2=Cancel; 3=Abort; 4=Retry; 5=Ignore; 6=Yes; 7=No

if sys(80)>0 then 'if at least 1 entity is selected...
sys(1027)=3 'message box style = Yes/No/Cancel
message " Selected only?..."
if sys(1028)=2 then end 'message box: 1=OK; 2=Cancel; 3=Abort; 4=Retry; 5=Ignore; 6=Yes; 7=No
end if


'this requires that the dcadalias.d3i file be in the dcad root directory

Include "*\dcadalias.d3i"

For j = 1 To Sys(9) ' Sys(9) is the number of entities
Entity j

if sys(1028)=6 then 'if message box=yes (if selected only)
if sys(96)=0 then goto nex 'if entity is not selected [0=not selected, 1=selected]
end if

for i = 1 to sys(1)

Query Ent_Point, i, ptX, ptY, ptZ
Change Ent_Point, i, 0, ptY, ptZ
update
next i

sys(1) = 0

nex:
next j

>regenerate
{
}

sys(1027)=0 ' message box style = OK (default)
message "Done. If no change is apparent then Fit to Window and /or Regenerate the drawing (or Regenerate All) ..."
'*******MACRO-2 END************


'*******MACRO-3 START**********
'Flatten-Y.d3m
'28 Jan 06 modified by Lawrence C. Smith, Nassau, Bahamas
' make for y and added 'select only?' to Impulse's 'flat-z' macro..

'iterates through the drawing and sets all Y coordinates to 0

sys(1027)=1 ' message box style = OK/Cancel
message "This command will make Y value of points = 0 and can not be Undone. To proceed click OK. To Abort click

Cancel..."
if sys(1028)=2 then end 'message box: 1=OK; 2=Cancel; 3=Abort; 4=Retry; 5=Ignore; 6=Yes; 7=No

if sys(80)>0 then 'if at least 1 entity is selected...
sys(1027)=3 'message box style = Yes/No/Cancel
message " Selected only?..."
if sys(1028)=2 then end 'message box: 1=OK; 2=Cancel; 3=Abort; 4=Retry; 5=Ignore; 6=Yes; 7=No
end if


'this requires that the dcadalias.d3i file be in the dcad root directory

Include "*\dcadalias.d3i"

For j = 1 To Sys(9) ' Sys(9) is the number of entities
Entity j

if sys(1028)=6 then 'if message box=yes (if selected only)
if sys(96)=0 then goto nex 'if entity is not selected [0=not selected, 1=selected]
end if

for i = 1 to sys(1)

Query Ent_Point, i, ptX, ptY, ptZ
Change Ent_Point, i, ptX, 0, ptZ
update
next i

sys(1) = 0

nex:
next j

>regenerate
{
}

sys(1027)=0 ' message box style = OK (default)
message "Done. If no change is apparent then Fit to Window and /or Regenerate the drawing (or Regenerate All) ..."
'*******MACRO-3 END************
 

Files to Download: