Author Topic: Export command replacement  (Read 441 times)

bdeck

  • Hero Member
  • *****
  • Posts: 780
Export command replacement
« on: June 06, 2016, 10:10:07 AM »
This was written primarily to export files having progressive dimensions, where the progressive dimensions have been edited to render correctly in DC after saving. (or where they have been initially drawn using the dp.d3m macro)

Note: if any items are selected, this version will correct only the selected dimensions and will export the entire drawing.

This version fixes only dimensions having a combination of dual arrowhead styles and text located to right or left.

See version 1.0 later in thread for different behavior.

Works in DC versions 18.2-25.2
 
Code: [Select]
' xport.d3m  version 0.0  bd   6/6/2016  Works in DC versions 18.2-25.2

' Exports files having unexportable content (ie progressive dimensions)     

' Conditions progressive dims for export, exports the file, then reverses all changes made prior to export.

Alias ENT_SELECTED  &H010C
Alias ENT_TYPE  &H0101

Alias D_EnableSecondArrow &H0A17
Alias D_ArrowType &H0A01
Alias D_ArrowType2 &H0A16
Alias D_TEXTPOSITITION_HOR &H0A15

gosub checkversion

ne0=sys(9)   ' number of entities in drawing at outset
if ne0 < 1 then end

dim entno(ne0)
dim ahd1(ne0)
dim ahd2(ne0)

gosub Fixall
gosub sendit
if fixcount>0   then gosub unfix

end

FixAll: 'change progressive dimensions
fixcount=0
ns0=sys(80)
for n=1 to ne0
entity n
query ent_selected entsel
if (ns0<1) or (entsel=1) then
  query ENT_TYPE t
if t=75 then 'Is this a dimension?  DC now changes all type 79 to type 75.
query D_EnableSecondArrow esa 'If dimension has 2 different arrows, then 
if esa>0 then
query D_TEXTPOSITITION_HOR  htpq
if (htpq=1) or (htpq=3)  then
htp=htpq+1
entity n
query  D_ArrowType ah1
query  D_ArrowType2 ah2
change D_TEXTPOSITITION_HOR htp
change D_ArrowType ah2
change D_ArrowType2 ah1
update
fixcount=fixcount+1      'archive arrow styles
entno(fixcount)=n
ahd1(fixcount)=ah1
ahd2(fixcount)=ah2

endif
endif
endif
endif
next n
return

unfix: ' undo all the changes made in  Fixall
for i=1 to fixcount
entity entno(i)
query D_TEXTPOSITITION_HOR htpq2
htp2=htpq2-1
change D_TEXTPOSITITION_HOR htp2
ah1=ahd1(i)
ah2=ahd2(i)
change D_ArrowType ah1
change D_ArrowType2 ah2
update
next i
regen
return

sendit:
xdir$=sys$(38)
pt$="."
xtype$=""
do while xpath$=""
ptpos=1
do while ptpos=1   'prevent filename starting with point
xname$=""
Input "Choose export filename. (Default to Source filename)." xname$
If xname$="" then xname$=sys$(3)
ptpos= INSTR(xname$,pt$)
loop
if sys(999)=1 then    
xpath$=chr$(0)             ' exit if input was cancelled
else
if ptpos>1 then
if RIGHT$(xname$, 4) ="dxf" then xtype$="x"
if RIGHT$(xname$, 4) ="dwg" then xtype$="w"
nmlen=ptpos-1
xname$= left$(xname$,nmlen)
endif

if xtype$="" then Input "Choose destination type. x = dxf, w= dwg", xtype$
if sys(999)=1 then    
xpath$=chr$(0)             ' exit if input was cancelled
else
if (xtype$="x") or (xtype$="X") then
xpath$=xdir$+"\"+xname$+".dxf"
gosub filecheck
if xpath$ >"  " then gosub dxfsend
else
xpath$=xdir$+"\"+xname$+".dwg"
gosub filecheck
if xpath$ >"  " then gosub dwgsend

endif
endif
endif
loop
return

filecheck: ' check to prevent overwrite of existing file
if EXIST(xpath$) then     
sys1027=sys(1027)
sys(1027)=3                                              ' yes/no/cancel message box
msg$= xpath$+"  already exists. Overwrite?"
message msg$
rply=sys(1028)
sys(1027)=sys1027
if rply<>6 then xpath$ ="  "      ' if not yes then exit normally
if rply=7 then xpath$=""          ' or re-enter file name
endif
return

dwgsend:
>DwgOut
{
<Filename [xpath$]
'<Type 8           '8= version 2004   set here or preset manually in the file/export/version dialog
'<GridType 0
'<HatchType 0
}
return

dxfsend:
>DxfOut
{
<Filename [xpath$]
'<Type 8           '8= version 2004   set here or preset manually in the file/export/version dialog
'<GridType 0
'<HatchType 0
}
return

checkversion:
verno$=sys$(105)
if verno$<"18.2" then
message "DP macro requires DC version 18.2 or later."
end
endif
return


« Last Edit: June 09, 2016, 04:56:45 AM by bdeck »

bdeck

  • Hero Member
  • *****
  • Posts: 780
Re: Export command replacement
« Reply #1 on: June 08, 2016, 04:25:11 PM »
This version  modifies any dimension having either dual arrow head styles or right/left text location. It will alter any dimension having text over the first extension line or a non-pointed arrow over the second extension line prior to export.

Also provides an option to export selection only or entire drawing.

Code: [Select]
' xport.d3m  version 1.0  bd   6/8/2016

' Exports files having unexportable content (ie progressive dimensions)     

' Conditions progressive dims for export, exports the file, then reverses all changes made prior to export.

Alias ENT_SELECTED  &H010C
Alias ENT_TYPE  &H0101

Alias D_EnableSecondArrow &H0A17
Alias D_ArrowType &H0A01
Alias D_ArrowType2 &H0A16
Alias D_TEXTPOSITITION_HOR &H0A15

Alias iCancel sys(999)

gosub checkversion

ne0=sys(9)   ' number of entities in drawing at outset
if ne0 < 1 then end

dim ano(ne0)  'fixed arrow count
dim tno(ne0)  'fixed text count
dim ahd1(ne0)
dim ahd2(ne0)

gosub Fixall
gosub sendit
if fixTcount>0   then gosub unfixT
if fixAcount>0   then gosub unfixA

end

FixAll: 'change progressive dimensions
fixAcount=0
fixTcount=0
ns0=sys(80)      'number of selected entities at outset
XprtSeln=0    'initialize selection-only flag to 0
if ns0>0 then
input " A = export all,  S = export selection only (default)", xas$
if iCancel then end
if (left$(xas$,1)<>"a") and (left$(xas$,1)<>"A") then XprtSeln=1
endif
for n=1 to ne0
entity n
query ent_selected entsel
if ((XprtSeln=0) or (entsel=1)) then
  query ENT_TYPE t
if t=75 then 'Is this a dimension?  DC now changes all type 79 to type 75.
query D_EnableSecondArrow esa 'If dimension has 2 different arrows, then 
if esa>0 then
query  D_ArrowType ah1
query  D_ArrowType2 ah2
if ah2=3 or ah2=6 or ah2=7 then   'if second arrow is of a type that should be in first position, change it
change D_ArrowType ah2
change D_ArrowType2 ah1
update
fixAcount=fixAcount+1     'archive arrow styles
ano(fixAcount)=n
ahd1(fixAcount)=ah1
ahd2(fixAcount)=ah2
endif
endif
query D_TEXTPOSITITION_HOR  htpq
if (htpq=1) or (htpq=3)  then
htp=htpq+1
entity n
change D_TEXTPOSITITION_HOR htp
update
fixTcount=fixTcount+1      'archive arrow styles
tno(fixTcount)=n
endif
endif
endif
next n
return

unfixT: ' undo all the changes made in  Fixall
for i=1 to fixTcount
entity tno(i)
query D_TEXTPOSITITION_HOR htpq2
htp2=htpq2-1
change D_TEXTPOSITITION_HOR htp2
update
next i
return

unfixA:
for i=1 to fixAcount
entity ano(i)
ah1=ahd1(i)
ah2=ahd2(i)
change D_ArrowType ah1
change D_ArrowType2 ah2
update
next i
regen
return

sendit:
xdir$=sys$(38)
pt$="."
xtype$=""
do while xpath$=""
ptpos=1
do while ptpos=1   'prevent filename starting with point
xname$=""
Input "Choose export filename. (Default to Source filename)." xname$
If xname$="" then xname$=sys$(3)
ptpos= INSTR(xname$,pt$)
loop
if sys(999)=1 then    
xpath$=chr$(0)             ' exit if input was cancelled
else
if ptpos>1 then
if RIGHT$(xname$, 4) ="dxf" then xtype$="x"
if RIGHT$(xname$, 4) ="dwg" then xtype$="w"
nmlen=ptpos-1
xname$= left$(xname$,nmlen)
endif

if xtype$="" then Input "Choose destination type. x = dxf, w= dwg", xtype$
if sys(999)=1 then    
xpath$=chr$(0)             ' exit if input was cancelled
else
if (xtype$="x") or (xtype$="X") then
xpath$=xdir$+"\"+xname$+".dxf"
gosub filecheck
if xpath$ >"  " then gosub dxfsend
else
xpath$=xdir$+"\"+xname$+".dwg"
gosub filecheck
if xpath$ >"  " then gosub dwgsend

endif
endif
endif
loop
return

filecheck: ' check to prevent overwrite of existing file
if EXIST(xpath$) then     
sys1027=sys(1027)
sys(1027)=3                                              ' yes/no/cancel message box
msg$= xpath$+"  already exists. Overwrite?"
message msg$
rply=sys(1028)
sys(1027)=sys1027
if rply<>6 then xpath$ ="  "      ' if not yes then exit normally
if rply=7 then xpath$=""          ' or re-enter file name
endif
return

dwgsend:
>DwgOut
{
<Filename [xpath$]
<SelectOnly [XprtSeln]
'<Type 8           '8= version 2004   set here or preset manually in the file/export/version dialog
'<GridType 0
'<HatchType 0
}
return

dxfsend:
>DxfOut
{
<Filename [xpath$]
<SelectOnly [XprtSeln]
'<Type 8           '8= version 2004   set here or preset manually in the file/export/version dialog
'<GridType 0
'<HatchType 0
}
return

checkversion:
verno$=sys$(105)
if verno$<"18.2" then
message "DP macro requires DC version 18.2 or later."
end
endif
return
« Last Edit: June 09, 2016, 05:06:37 AM by bdeck »